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ABSTRACT 


This paper is a documentation of computer materials devel- 
oped by the Institute for Defense Analyses (IDA) for use by the 
Defense Civil Preparedness Agency (DCPA). All IDA physical 
data processing materials (IBM cards, magnetic tape, computer 
printouts) have been surveyed and catalogued. All computer pro- 
grams are written in FORTRAN (a general knowledge of this 
language is assumed in the detailed descriptions contained 
herein). Computer programs considered useful by IDA have been 
included and documented. A group of general purpose subprograms 
are described, along with their interfaces with the using pro- 
grams. Data file formats also have been developed, along with 
programs for managing these files. Such programs and resulting 
files are described in detail. 
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Volume I 


Chapter } 


Mae INTRODUCTION 

For over a decade the Institute for Defense Analyses has 
been conducting studies for the Defense Civil Preparedness 
Agency (or the Office of Civil Defense). Many of these studies 
have involved the development and use of computer programs. A 
legacy of such efforts is a substantial body of data processing 
materials collected over a number of years. During the last 
year IDA has engaged in an effort to identify these materials, to 
discard that no longer useful, to modify the remainder when 
appropriate to reflect present or possible future needs, and to 
document the resultant product. This paper presents the 
documentation. 

Much of the material identified was considered no longer 
useful and was discarded. For example, data files based on the 
1960 census were considered no longer useful and mostly discarded. 
(A few exceptions were made since the geographical basis of 
the 1970 census files is different than the National Shelter 
Survey, which used the 1960 Census RSAC codes.) In July 1970 
IDA switched from a Control Data Corporation 1604 computer to a 
Control Data Corporation 6400 computer, with the result that many 
of the 1604 programs were unusable on the 6400 without extensive 
revision. The general criterion for selecting computer programs 
for retention was that the effort in understanding, modifying, 
and adapting an old program for possible future use be less than 
writing a new program. The general criteria for 


retaining old data files is that (1) the source of such data 


“eg 


are not readily available covering the same subject but with more 


recent information. The result of applying these criteria result 
in many files discarded, with remaining files in a variety of for- 
mats, and led to the conclusion that the prime data effort should 
be in developing methodology for retaining data files, and put the 
most essential files in the format of this methodology. 

It seems apparent that as this documentation becomes too 
voluminous that its utility is correspondingly decreased. 
Accordingly a conscious effort was made to only include in the 
documentation information which might be of substantial hetp.? 
Many previous IDA reports have contained descriptions and docu- 
mentation of computer programs on data files. In such cases a 
reference to this information is given, and the information is 
not repeated here. The number of computer listings was kept to 
the minimum consistent with adequate documentation of pertinent 
materials. 

For many years IDA has had a frequent and fruitful relation- 
ship with the DCPA Computer Center. A number of major programs 
have been originally developed at IDA but subsequently used (often 
with substantial modifications and improvements) at the DCPACC. 
Where such programs are maintained and available at the DCPACC, 
the documentation in this note of such programs will be restricted 
to that which might supplement that information already available 
at DCPACC. it is thus hoped that this note might be of help to 


the DCPACC when they use IDA originated programs by attempting to 


IMaterial not specifically described is still available at IDA for use. In 
particular, catalogues and files of data tapes, IBM card decks, and computer 
lal 


produced listings of programs and results of runs are available in the Civil 
Defense Data Processing Library. 
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clarify obscure points, without needlessly replicating informa- 
tion already available. 

A codification of many existing subprograms at IDA was 
conducted in 1972 under the acronym "NEVUNS." This material is 
the basis of Chapter 3 on subprograms. It was the hope at that 
time, and still appears as an appropriate goal, that many major 
programs could be rapidly constructed by assembling and selecting 
from a well tested and documented set of subprograms, each of 
which accomplishes a specific task. Many of these subprograms 
nave, in fact, been utilized in programs developed since then 
and have resulted in substantial savings in effort. It is ‘strongly 
hoped that in future activities this type of capability can be 
continued and expanded. 

In the environment of development of programs intended to 
be run on more than one computer, a conscious effort should be 
continuously made to write code which is as machine independent 
as possible. It is thus hoped that much of the data processing 
material presented here will still be useful for advanced computer 
systems, and will not have to be discarded when the original 
machines they were developed on are discarded. In particular, 
the subprograms could be readily translatable to new machines as 
long as a reasonably complete version of FORTRAN is retained as 


a machine capability. 
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Chapter II 


COMPUTER PROGRAMS 


This chapter describes IDA computer programs. The 
selection of programs to be included followed the criteria 
of Chapter I. Most of the programs not included are either 
of a very temporary nature to test the correctness of a 


particular subprogram, are programs to accomplish small data 
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e manipulation tasks, or are for obsolete machines. An 
exception to the exclusion of direct file manipulation rou- 
tines are a set of special purpose, single use programs at 
the end of the chapter included to illustrate the development 
of standard files and document more fully the resultant files. 
Where programs have been documented in previous refer- 
ences, the documentation is not given here. When programs are 
documented, the documentation consists of descriptive text 
y annotated listings. The form of the documentation 
varies considerably from program to program simply becuase 
different programs need different documentation techniques. 
In some cases, inout requirements are transparent from the 
prosram listing, in othérs not. The program annotation des- 
cribes the tasks performed by various sections and points out 
particular calculations where needed. When subprograms are 


NEVUNS Standard, the documentation is given in Chanter IV. 


The meanings of the critical variables are either described in 


COMPUTER PROGRAM DESCRIPTION 
NAME: DISCRN 
SYNOPSIS: Fallout Dose Calculation 


TYPE: Single Use 


USE: To Calculate Hot Line Doses and Crosswind Standard 
Deviation in Fallout Risk Development 
BACKGROUND: Developed to find First Approximations to WSEG-10 | 
DESCRIPTION: Many Calls to WSEG-10 Model Followed by Printout 
of Appropriate Parameters 
INPUT: In Program 
OUTPUT: IDA Run #62 
STORAGE: IDA Card Deck #40 
DOCUMENTATION: 


LANGUAGE/SYSTEM: RUN (FORTRAN)/6400 Scope 


COMMENTS : | 
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COMPUTER PROGRAM DESCRIPTION 


NAME: SWOOSH 
SYNOPSIS: WSEG-10 Fallout Dose for Many Conditions 
TYPE: Single Use 


USE: To Present Fallout Dose Values for Many Combinations of 
Yield, Wind Speed, Wind Shear, Downwind Distance and 
Crosswind Distance 


BACKGROUND: Developed to Produce a Reference Catalog of Fall- 
out Dose Values 


DESCRIPTION: The WSEG-10 Model is Repeatedly Called for a 
Variety of Conditions Controlled by Do Loop. 
Dose Rates at Various Times and Crosswise Dis- 


tances to Various Dose Levels Also Given 
INPUT: : 


Parameters in Program 
OUTPUT: IDA Listing #59-62 
STORAGE: IDA Card Deck #208 
DOCUMENTATION: 


LANGUAGE/SYSTEM: Run (FORTRAN)/6400 SCOPE 


COMMENTS: Copy of Catalog Supplied to DCPA 
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COMPUTER PROGRAM DESCRIPTION 


NAME: DWNFIT 
SYNOPSIS: Fit Fallout Crosswind Dose 
TYPE: Single Use 


USE: Determine shape of fallout doses crosswind as a function of 
downwind dose and attack pattern 


BACKGROUND: Used as part of analysis in paper. 


DESCRIPTION: Doses as a function of crosswind distance are computed 
with the WSEG-10 model and are presented for various 
parametric combinations of weapon yield, attack pattern, 
downwind distance, and wind 


ee Parameters in program. 


OUTPUT: Printouts. 

STORAGE: IDA Card Deck #50 

DOCUMENTATION: IDA Paper P-1065, "Methodology of Fallout Risk 
Assessment," Leo A. Schmidt, January 1975 


LANGUAGE/SYSTEM: FTN/6400 SCOPE 


COMMENTS : 
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COMPUTER PROGRAM DESCRIPTION 


NAME: WINDST 
SYNOPSIS: Determine wind direction probabilities 
TYPE: Single Use 


USE: Used to compute probability wind has a direction 6 as a 
function of @ with wind vector sum of a mean wind and 
circular Gaussian random component. 


BACKGROUND: Written to obtain charts used in the risk paper. 


DESCRIPTION: The probability is computed by using an expression 
which gives all possible random wind components with 
resultant direction @ and summing these probabilities. 


INPUT: In program, cycles through various parameter values 

OUTPUT: Printout 

STORAGE: IDA Card Deck #35 

DOCUMENTATION: IDA Paper P-1065, "Methodology of Fallout Risk 
Assessment," Leo A. Schmidt, January 1975 


LANGUAGE/SYSTEM: FTN/6400 SCOPE 


COMMENTS : 


— see eee er ee 


COMPUTER PROGRAM DESCRIPTION 


NAME: LASH 
SYNOPSIS: MONTE CARLO Fallout Dose Distributions 
TYPE: Production 


USE: Study Effect of Wind Statistics, Weapon Pattern on 


Fallout Doses 


BACKGROUND: Developed as Exploratory Program in 1972 
Used in Fallout Risk Studies--Bases of Other 
Applied Programs--RUBATO, TFPLOT COLPLT 


DESCRIPTION: Has MONTE CARLO Simulation of Wind Statistics and 
Weapon Arrival to Compute Fallout Doses with 
WSEG-10 Fallout Model 


INPUT: Parameter Cards-see IDA Card Decks 41, 97 
OQUTPUEFs IDA Run 44, 52, 52, 74, 107 
STORAGE: IDA Card Decks # 96, 97 


DOCUMENTATION: IDA Paper P1065, "Methodology of Fallout-Risk 
Assessment" Leo A. Sehmidt, Jr., Jan. 1975 


LANGUAGE/SYSTEM: FTN/6400 SCOPE j 
FTN/3600 SCOPE 
FTN/3200 SCOPE 
6400 Version is ANSI Standard FORTRAN 


COMMENTS : 


3200 Version Experimental Interactive Program. 
Long Running on This Machine. For Other Machines 
Run Time Depends Upon Number of Trails, Number of 
Weapons, and Number of Monitor Points. 


previous paper. This description will thus restrict itself 
to the computer implementation of the algorithms. The 
first part of the listing for the program RUBATO contains 
the definitions of program parameters. 

The program reads a set of data cards in three sub- 
routines PARIN, WPNIN, and TGTIN. The meaning of the input 
variables read in these routines will be described along with 
the implications on the resulting programs. 

The following parameters are read in subroutine PARIN: 

DMOST--For each monitor point the number of occurrences of 
doses in three types of intervals--even intervals, 
eaual logarithmic intervals, and dose intervals 
specified in a data statement in the array BV ar 


output. For the even intervals DMOST is the dose for 
the highest interval. 


i 


NDSEV--For the even interval doses, the variable gives 
the number of intervals. 


SMLDOS--Since the dose distribution is highly skewed with 
a large number of small doses, dose statistics 
are presented for the full distribution and also 
only for those doses over the value SMLDOS. 


WIND--Speed of the mean wind, mph. 


SGWP--Standard deviation of random wind as a fraction 
of the mean wind speed. 


, SHR--Wind shear for WSEG=-10 model use, mph/kft. 


fed 


SGSHRP--Standard deviation of wind shear as a fraction 


a 

« of mean shear. The wind shear is assumed to 
% be normally distributed. 

Pd 


MDCAL=-Typve of dose used. O--Usual WSEG=-190 biological 
x dose, 1 is biological dose at 800 hrs., 2 is 
maximum biological dose. 


angter 


err 


NSAMP==-Number of wind samples to be used 


ISTRAT--If 1, do stratified wind samples 
speed from each of ten equal vroba 
vals and wind direction from each 
vals. Number of samples should be an even 

itiple of 100. 


MQCK--If 1, use rapid approximation to WSEG-10, if 
0, use regular WSEG-10. 


SEED--Random number generator seed. If this value 
is 0, use a computer clock reading to obtain 
a random seed. 


IDEGI--If 1, input weapon coordinate by latitude and 
longitude. If 0, input target and weapon 
coordinate by miles, downwind and crosswind 

rom some arbitrarily chosen origin. 


, WMNDR--Mean wind direction, degrees clockwise from 
north, only needed when IDEGI=1. 


XCLAT=--Center latitude weapon of target system. On 
input target location is converted to a rec- 
‘ tangular coordinate system centered at XCLAT, 
YCLAT. This variable allows control of the 
origin of the rectangular system. 


YCLON~-Center longitude of target system. 


IDEGC--As IDEGI but for target system. The following 
variables are input in the subroutine WPNIN fo 
each weapon used. 


» 
£ 


YLDA(I)--Weapon yield in MT. 


f FISSA(I)--Weapon Fission Fraction. 
&. 
x HORA(I)--Weapon Height of Burst in feet. 
TWPNA(I)--Time of weapon detonation, hrs. Not needed if 
i MDCAL=0. 
* Eres ‘ 
¥ DCLA(1I)--Weapon reliability 
x 
XWA(I)--Crosswind weapon distance 
CWLAT(Ii)=<Weaoon latitude 
+ 
F 


Tele 


YWA(I)--Crosswind weapon distance. 

YWLON(I)--Weapon longitude. 

If all yields are the same, the flag MONOY is set to l, 
otherwise 0. If all yields are the same, yield and wind 
dependent WSEG-10 fallout calculations are done only once, 
if not, they are done for each weapon separately. 

The following variables are read by the subroutine TSTIN. 

For IDEGC= 

| XTL(I)--downwind target location 

YTL(I)--crosswind target location 


For IDEGC=1 


PPI me ie 


XCTLT(I)--target latitude 


YCTLO(1I)--target longitude 


rage me 


NAMEC(1I,J,J=1,2)--target name 


— 


aia eem tee 


BO a te BaD ri ome 


_ ae oe 


“eigee 


Seago tee a . -- . er = 


eccn 


30 


33 


34 


aaee UNCLASSIFIED eeee 12/14/76 PAGE NO. 90 


PROGRAM LASH(INOUT,OUTPUT) 


DOES A MONTE CARLO CALCULATION OF THE DISTRIBUTION OF NOSES FOR 
CIRCULAR NORMAL RANDOM WIND VECTORS 
L. SCHMTOT EAT, 346 


COMMON/WPNPR/ YLOA(200) 9F1SSA(200) eCEPA(200) »HOBA(200) » THPNA (200) » 
1 DELA(2N0)9 xwAl20n)s YWA(2N0) 9 XWLAT (200) eYWLON(200) 5 IMAXy 

2 XCLAT#YCLON pARRYA (500940) sARRYT (200) 

CoMMOn/ STARR XL8V(51) 049150950) ey8b(50950)5 yBE(1U1950)% 

1 RE(LOS)s NMAX (59) 9 §$0(50)2 SOS(50),5 

2 SMC(59) 6 SUF (60) AV (51) #NBOXA PNBOXL #NBOXE eUMOST »NOSEV 

32 sDTOTeSMLOOSes6D( 52) 9§SD5(50) 95500150) »ssDF (50) » NgML (50) 

COMMON/ TOPR/IN,AI 4 IRUG 

COMMON/TARPR/XTL (50) 9YTL (50) eJTGTSeXCTLT (50) sYCTLO(50) sNAMEC (5090) 
COMMON/wNDpp/wINOssGWprstarsGciRaprsGwsslGshos SHRSTe 

1MOCAL» NSAMP»® MONOYs. NRPT 9 kNSAMP sISTRAT»TOEGI »wMNOR,IDEGC 

> eSALeCaleVeMQck 

COMMON/LAZY/SEEN oTTASTTBsTTCoTTOOKTAsKTBeKTCeKTD 


IN = 5LYNPUT 
NI = 6LOUTPUT 


CONTINUE Ss 
READ( Ines) TOVEA Aad Da de! 
FORMAT (110) Abohss 


CALL pAgiy ; 
Call WPNIN Aral / at fl hice? 
Call TGTIN ) 


CaLL INYT 

NRPTS = NSAMP/100 

DELTH © ge6289;853 proc! Lig avd 
Zales 

CONT INUF Sh Looe at 

fe (TSTRAT .E0,.1) GO TO 53 PLE ID 


NRPT 2 NRPT © 7 
THETA = 66285) 2639* RANF (9) 
TMZ 2 RANF (9) 
GO TO Sa 
CONTINUF 
POLN = ae 
00 31 IS= lein 
THOLD = 0, 
59 32 ues leln ‘ 
0 33 Ks= 1,NROT 
THETA # THOLU » DELTH*RANF (0) Ltrot wf harlow Wad 
TZ 2 PALD + 0,7 *RANF (0) } 


ConTInNue , 4 
Vw2 = SORT( 2eaSGwe SGW #A4LOG(leyile= TMZ) )) Slane” f Lavvinrn Moll 
CALL WNOCAL(VwQ4 THETA) 


00 100 KT = ye JTGTS (AE Bp O ware lpm 
Orory 2%. 
00 40 % = Leilmax eee: a aed 
COME 2 DANF (YQ) ha : “) LAA Hou - 7 : 
LF (DELA(K) oT, COMES 30 TO gn Senf ois bow Pisleale = 
eeee NCLASSIFTEN #80 ~~ = L2shus 76 PAGE yo, 90 
WOT 


WeECCAIN Z 
@ Kroe BLawh FiLMES 


PRET 


20 


1u0 


56 


Me: 
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ea@e UNCLASSIFTED eee9 12/14/76 PAGE NO, 00 
CALL DSSCL (Keke) AL) or03 + Eke! von yay} : 
CONTINUF . os: ge Lib ibowridet 2 
CALL BOXFLIKT) A Ade tivte 
CONTINUE freed (4h Yowigiene 

2 — 
IF(ISTRAT s£U. 1) GO TO 55 : 
IF( NRPT .bTe NSAMP) GO TO 3n [Prcepr Prabepl fse 
GO TO Se pee Ma ] 
CONTINUE 
CONTINUE 
THOLO 2 THOLU « DELTH 
CONTINUE 
PoLPD = POLD + 3,1 4 
CONTINUF Se Pte et = 
NSAMP = 100@NKETS heey pthden 
XNSAMP = NSAMP Ee tak 
CONTINUE : Ath Dhred 120 f tine 
EE SEI. 


CALL WRTLST paper har 


IF(TOVER yLTe 4) GOTO 2 retin 


STOP 6470 
END 
Lite avo ania 
BLOCK DaTA 
COMMON/STAPR/ XLBV (51) 9NR (502950) 99NBL(500950), NRF (101950)> 
1 BE(102)» NMAX(30)9 §0(50)9 SDS(59)¢ 


2 SO0C(SA)_9 SUF (SO) eBVIS2?) »NBOKASNEOXL ¢NBOXE «DMOST eNDSEV 
3 eDTOT#SML00SeSS0 (5%) #SSD0S (5) «SS0C(50) »SSOF (50) * NSML (50) 


DATA BY/ 
20,001009200050,9100.9 20008 300.9 400.9 SO%ee 690.9 700% B00ee 
3900.0 1N00ee 2AN0ee 3000|es 4000s 5000, 500s 10000.» 2000008 
4 49000,0 6000, + 29000,» 10n000,% 200000. . 400000,, 1000090,,/ 
END mt 

3 


SURROUTINE INIT 
InITIALTZES TRE CALCULATION 


COMMON/STAPR/ XL3V (51) enR (50950) 9NBL(50950)6 NRE(1U19S0) 6 
1 RE( 102), NmMAx (50) 5 $0(50)9 SOS(50), 
2 SNC(Se)» SUF (50) 8V (51) »NROXAeNBOXL sNXOXE »OMOST »NOSEV 
3 sDTOT#SM,V0SeSS0 (5%) #SSOS (50) oSS0C (50) »SS0F (50) * NSML (50) 
CoMMon/TOpR/ lyon ts f8uG 
COMMON/WPNPR/ Y¥L0A(200) oF 1SSA(200) eCEPA(200) #HOBA(200) »TWPNA(200) » 
1 DELA(200)5 Xwal200)+ YWAa(200) 9 XWLAT (200) eYWLON(200) 5 IMAXs 
2 xClAgeyCLONsAnn yA (200640) sAnpyy (200) 
COMMON/ WNDPR/WTAD e SGWP SHR eSGSHRPOSGWeSIGSHO*s SHRST» 
IMpCals NSaMPe MONDY. NRPT 4xXnSaMP eISTRATsTUEGI #WMNOR es IDEGC 
2 gSdbeCalyyeMnck 
COMMON/TARPA/XTL (50) ,YTL(SO) UTGTS XCTLT(S0) ,YCTLO(SO) NAMEC(SO 2) 
COMMON/| AZY/SEER eTTASTTBeTTCoTTDORTAOKTByKTCyKTO . 


IBUG = ? 


eete UNCLASSIFIED eee 12/14/76 PAGE NO, pou 


| eave UNCLASSIFIED oon@ 


TBUG 3 1 
IgUG = a 
NBOXA 7 28 
NRBOXL = 37 
| NBOXE = NDSEV « } 
XLBV(1) = ge 
XLG 3 go. 
DO 3 J = 2eNBOXL 
| XLBV(J) = 1008*xXLG 
XLG = XLG ¢ 062 
3 CONTINUE 
DELD = NMOST/NNSEV 
00 SZ ye 
| 00 5 J = 1 9NuOxe 
BE ty) = 0D 
OD = 0D + DELO 
> CONTINUF 
BV(NBOXA « 1) 
| XLBVINSOXL o)) 
BE (NBOXF « }) 


DO $4 K = levTGts 
Oo 51 J 2 LeNROXA 
Ng(JeK) 2 0 
$1 ContIQuF 
| Do 52 J = 1,NBOXL 
NBL(JeK) 2 A 
32 CONTINUE 
00 53 J 2 leNBOXE 
NBE(JeK) = 0 
| 33 ContInNuFr 
Nal (NBOXL 


OMAy(K) = 
| SO(K) = 0, 
SOS(K) 
SOC (K) 
SNF (K) 
| SSO (K) oe 
SSOS(K) = ye 
SsOC (kK) = 9g. 
SSOF(K) = Qe 
NSML(K) = ny} 
| 34 CONTINUF 
NRPT sf 


un 
QoQ 
e 


| IF( SEEN ,NE~e 4.) 60 TO 32 


CALL TIME(CLTIM) 
CLTIM * ABS(CLTIM ) 
CALL RANSET(CLTIM) 
: GO TO 33 
[ 32 CONTINUF 
CALL RANSET (SEEN) 
33 CONTINUE 


Do 256 I = Lelmax 


| IF (MONOY ,£9.1) GO TO 27 


Ie (MACK ef. 1) GO TO 36 


ae%e | |NCLASSIFIEN #808 i 


NB( NBOxA @ 1,k) 2 fA 
* eK) Ba 

NRE(NROXE * lek) 3 9 
0) 


12/14/75 PAGE NO, “0¥ 


= 999999999, 
= 999999999, 
= 999999999, 


frtiales Lalor Tier fr 
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RR = 


aaee \INCLASSIFTEND aee@ 12/14/76 Y 
CALL FALLY(YLDA(I)«. FISSA(I)« HOBA(I) + ARRYT) 4 
GO TO 37 

35 CONTINUF 
CALLQFALLY (YLOA(I)« FISSA(I). HORA(I)» ARRYT) 

37 CONTINUF 
On 26 J & 196 
ARRYA(IeJ) = aRRYT(J) 


Ne ee eS ee 


26 CONTINUF 
25 CoNyINUE 
Go TO 2R 


27 CONTINUF 
IF (MQCK eFQ. ) ice) TO 36 
CALL FALLY(YLDA(}) «6 FISSA(]) + HOBA(])*s ARRYT) 
GO TO 3,R 
3o CONTINUF 
CALLQFALLY (YLOA(1) 9 FISSA(1)«¢ HOBA(1)« ARRYT) 
38 CONTINUF 
Oo 29 I = LelMax 
00 23 J & leo 
AppvA(I,J) = AppYrid) 
23 ee 
29 ONTINUF ; 
28 CONTINUE - 4 W fo foareld us: 
a fe haste 


SURROUTYNE PARTN 


. gibeer\ get Sle 


¢ INPUTS PARAMETRIC VARIABLES INCLUDING WIND AND CONTROL VALUES 


J 
COMMON/WNOPR/WIND» SGWP 9 SHReSGSHRP »SGWeSIGSHR» SHRST, : 
1MOCAL, NSAMP, MONOY, NRPT ,XNSAMP ,ISTRAT,IDEGI,wMNOR, IOEGC 7 
2 gSALeCAlyVyMaeK 

CaMMON/STaPR/ XLEV(51) s9Aa(50950) NBL (50950) NRE(1U1950),4 
1 BE(102)» NMAX (50) 9 50(50)* SDS(50)+ 
2 SDC(5A)»4 SUF (50) eAV(S)) »NBOXAsNBOXL sNSOXE »DMOST »NDSEV 
sD TOT SSMLDOS6SS0 (59) »SSDS (5%) ¥SS0C(50) »SS0F (50) * NSMLI(50) 
COMMON/WweNpPR/ YLDA(209) oF 15541200) sCEPA(200) #HOS3A (290) »TWRNA(200) 4 
1 DELA(2N0)9 XwA(290)9 YWA(290)9 XWLAT (200) eYWLON(200) » IMAX,y 
> XCLAT®#YCLUNeARRYA (300940) sARRYT (200) 
Ca¥MON/TOPR/ Lents TAUG 
COMMON/LAZY/SEFD eTTA*TTBsTTCeoTTD9KTAsKIBsKTCoKTD 


READ(IN,4) DMOST» NNSEV, SMLODOS 
4 FORMAT( FlQeUs Tine FlOcd ) 


READ(INe12) WIND® SGWP »SHR »SGSHRP 
12 FORMAT(,F10.0) 
SGw 2 SGwp*wiNn 
SIGSHR = SHR®SGSHRP 
SuRST 2 SHR 
WRITE (NT977) 
17 FORMaT(1H1) 
WoltE(yIs9) wily lrgGweeske 
9 FORMAT LINO, @ FOR THIS RUN AVERAGE WIND SPEED & 9,F1004, @ “oP, 4 
1 oo STANDARD OFVIATION © S9Fyqege * TIMES AVGe= WIND SHEAK F#9F i 06 
o4e* MPH/KFT.® ) 


eave yNCLASSIFTFO eeee ys 12/14/74 PAGE yo, 099 


4 


a> 


oat 


‘ 


32 


3s 
33 


36 
34 


21 
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wRITE(NI97) SGSRRP 
FORMAT(1H 9 ®STD DEV OF SHEAR 2® 9Fl0059 *# TIMES AVG SHRe IF STD O 
1Ev IS ZFRO DU NOT MONTE CARLO SHEAR®) 


READ(IN,g13) MOCAL gNSAMP, ISTRAT »MQCK 
FORMAT (4110) 

MOCAL 9 WSEG BIO DOSE ONLY» 1 NMCSSC 310% 2 ALSO DMAX 
MONOY 29 SEVERAL YIELUS» 1 ONLY ONE YIELD 
XNSAMp = NSAMp 

WRITE(NT,8) NSAMP 

FORMAT(}Ho»s © THE SAMPLE SIZE 3 *% 16) 

IF (MOCAL ,NEe 0) GO TO 91 

WRITE(NTs95) 

FORMAT(]HO»s *USE WSES BIOLOGICAL DOSE) 

GO TO 94 

CONTINUF 

IF (MDCAL ,NEo1l) GO TO 92 

WRITE (NT 996) 

FORMAT(1HOs #uSE “MCSSC BIOLOGICAL DOSE*) 
Go To 94 

CONTINUF 

IF (MOCAL ,NEe2) GO TO 93 

WRITE(NT997) 

FORMAT(1HO® # USE NMCSSC MaxtMUM DOSE*#) 

Go To 94 

CONT INUF 

STOP666 

CONTINUE 

IF (ISTRaT eEQ@. 1) GO TO 15 

WRITE(NT 0) /) 

FORMAT(1HOs ® USE NON@STRATIFTED SAMPLES #) 
Go To 14 

CONTINUF 

WRITE (NT 913) 

CONTINUE 

FORMAT( 1HOs ® USE SAMPLES STRATIFIED BY RANIUS AND ANGLE INTO 100 
1 EQUAL PROBABILITY AREAS® ) 

IF (MQC’ eEQe 1) SQ TO 41 

WRITE(NT 943) 

FORMAT (1H0s ® USE REGULAR wSEG 10 CALCULATION®#) 
Gy TO 42 

CONTINUF 

WRITE(NT 944) 

FORMAT(}HOs & USE QUICK appROXIMATION TO REGULAR wSEG 10 CALCUL 
LATIAN®) 

CONTINUF 


READ( INe32) SEEO 
FORMAT( F10.0) 

IF( SEEN 4NEe a) GO TO 33 

WRITE (NT 935) 

FORMAT(1HOe ® USE CLOCK TO GIVE AUTOMATIC RaNDOM NUMBER SEED®) 
Go To 34 

CONTINUF 

WRITE (NT*36) SFED 

FORMAT( 1H0,*®USF RANOUM NUMBER SEED OF & Flce6) 

Conti yur 


READ(IN,21) IDEGT» “MNORy XCILAT® YCLON»IDEGC 
FOQMAT ( 110,3F19600, Ilo ) 
IF (IOESY ,NEe,) GO TO 35 


eehe nC  ASSIFTED eewae*? 12/14/76 _ 


09 


90 
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NCLASSIF IED s¥0e@ 12/1lés7% 24GE 
ze) yCbAg,yCLON 
o> FORMAT( 1HO. #'SE LAT LON FOw WEAPON INPUT, CENTER TARGET AT LAT = t 
Ye» F10,2, @ VEGREFS AND LON = % F10.2 #9 DEGREES® 
weltE(Nre27) wrDp 


2? FORMAT (1H o@ TRE MEAN WIND OYTRECTION IS @) Fl0e4s ® MELMEES CLO 
1CKWISE FROM Tae NOTH * ) 

25 CONyINUF 
RETURN 
END 


SUBROUTINE wrRNTA 
C READS WEAPON PARMETERS AND LOCATIONS 


COMMON/TOPR/IN AT, TRUG 

COMMON/wWPNPB/S YLOA(200) ,FISSA(200) ,CEFA (200) »HORA (200) ,TwrNA(200), 
1 pELA(2°0)+s XwA(>IF) © YWA(OON) +» AALAT (200) e¥WLON (3509), IMAX, 

2 xCLArevClynsA80G7A( 700940) sAguyT (200) 
COMMON/WNOPR/wITAD » SAWP eSHReSGSHRPSSGwySIGSH?s SHRST. 

IMnCalbe NSAMPe MONQY. NRPT 9 XNSAMP sISTHATs TYEGI pwMNOR,LOLGC 

2 ySdlL yo CALyVemyek 


wOITE (NT) 74) 


is FORMAT (1HO) 
TF(IDEGT ,tQe , ) Gn TO 3, 
WRITE (NT 978) 
tx FORMAT InGe ® [NPT WEAPON PARAMETERS %9//e10Xe11H WPN« NUs 6104 
1 YIELO VLOHFTSS. FRAC 919H Hte BURST 10H TIME DET. » 
2 1PHDEL. PRUB, ° 
3 10H AWNe LOC, 619M CRSe 1OCe : f/f 
ie hare 
MONOY = 1 
2) CONTINUE 


ReAN(IN,22) YuRAlT).» FISSA(T)«¢ HOBAII) »TWPN\(T) pVUELA(T) » 
KWACT) sYwacid 

Ze FORMAT( 7F 40.9) 

Ft YCOMEL) wey 0% GO: ta 24 

ef Neat? WO FO 64 


. ] 
fELNO | yiANactry 
30 TO 195 
le CONTINUE 
IrtYLOAct) eNFE, YTELUO) MONNY = 0 
i? CONTINUE 
WRITESNT O19) TeVYLOACT) oFISSA(T) 6 HOBA(I)» TWPNA‘T)» NELALI), 
Y KWACT) @YwACL) 
iy FOOMAT(1h ,lUx, LH(, Te, 14), 3X6 7E1g,3) 
Dae ey 
GQ TO 2y 
eu CONTINUE 
IMAX = Tf « jj 
RETURN 
4} CONTINUE 
L WEAPON TNPUT SY LATITUDE AND LONGITUDE 
CONV = BO.%4UKN,2/57RUe 
Tams 43955597, 8U6 


nate NCLASSIF CED o@a0 


32 FORMAT( 1HO_ @ INPUT WEAPON PARAMETERS %9//e19Xel14 WPNe NUe 410F - 
YIELO sLOMETSS, FRAC 819M AT. GYURST 4610H TIME DETe » 


1 
2 lOHOEL. pRYS. ’ 

3 10H OWNe LOC, 10H CRSe 1 0Ce ¢l0H WPN, LATe »¢ 10H #PNe LONe 
4 


| oe®e ,NCLASSIFTED e#0e 12/14/76 PAGE NO, 00 


| e//) 
Tel 
MONOY = 1 
THT = (wMNOR = 2706) #3014159765/1906 
| SNTHT = SIN(THT) 
COSTHT s COS(THT) 


35 CONTINUE 
READ(IN,22) YUNACI) > FISSACI1« HOBA(I) »TWPNA(T) SDELA(I) » 
L XWLAT(T) » YwLaAA (TL) 
| IF( YLOA(T) ele, 06) Go To 34 
IF (Il .N&el) GO 10 37 
YIELOO = yLOai(t) 


Go TO 3e 
37 CONT INUF 

| IF(YLOA(I) NE. YIELOO) MONDY 2 0 
38 CONTINUE 


CFAC = meS5*#TOHACP(KXWLAT(I) # XCLAT ) 
CeFac = Cos(CcFac) 
| DELLAT = ( XwLaT(I) * XCLAT ) # CONV 
OELLON s(YWLUN(T) @« YCLON } *CONV#CCF AC 
XWA(I) 2 @DELLCN®COSTHT = OFLLAT® SNTHT 
YwA(I) 2 DELLATaCOSTHT = DELLON®SINTHT 
WRITE(NT939) Ievboa(l) sFISSa(I)s HOBA(I)» TWPNA(T)»s DELA(I)» 
| 1 XWA(T) sYWA(I) 9 XWLAT(T) eYWLON(T) 
39 ForRMAT(1H e1l0x, lH(, 120 1H)6 3Xe 9F 10.3) 
Tete}. 
Go TO 36 
| 30 CONT INUF 
IMAX = fT - ] 
RETURN 
ENO 


| SUBROUTINE TGTIA 
| C READS TARGET LOCATIONS 


COMMON/TARPO/XTL (50) oYTL (50) eUTGTSeXCTLT (S50) sYCTLO (50) »NAMEC (5092) 
COMMON/WNDOPR/WIND » SGWPeSHReSGSHRPeSGWsSIGSHPs SHRST» 

| 1MOCAL, NSAMPs “ANOY, NRPT 9 XNSAMP so ISTRATs TOEGI swMNOR, IDEGC 
? eo SAL CAL yg VeMOCK 
“COMMON/WPNPR/ vi_Da (200) oF 1SSa (200) eCEPA (200) #HOBA(200) » TWPNA (200) + 
1 DELA(200)9 xwA(200)0 YWA(29N)® XWLAT (200) eYWLON(200) 6 IMAX, 

| 2 XCLAT»YCLON® APRYA (200940) sARRYT (200) 
COMMON/ TOPR/IN,ANI eg LRUG 


IF( IDESC eEU. 1) GA TO 31 


Bs a 2 
me | 1S Cont fNUF 
I { a | 

3 \ READ(IN,14) ATL (J) oe YTL (J) 

Li FORMAT( 5F1000) 

~ IF (x7L(u) eb te 10099006) Go to 15 
,* | JTGTS = 5 #1 
I : i RETURN 
| r eave UNCLASSIFIEN atat zz Vaslas7%s6 PAGE NO, 09 


CANTINUF 
CiTy INPUT BY LAT LAN 

TOPAD 2 3,)41599605/180. 

CONV = 40,%HUGN,2/5280e 

J 20 

TreT = (WMNUR © 2704, 0201%159265,1306 
SNTHT = SIN(THT) 

COSTHT = CUS(THT? 

CONTINUE 

UIE a Da ie 

REAN(IN,G4)) ACTLT( 1) YCTLO( 1) 9 NAMEC (507) eI AMEC (le) 
FORMAT( 5F1000~. 2aa ) 

Te txCrlo rly) eGr,. 19900006 2 SM TN 32 
CFAC = Fe5®TURALM(XCTLT (JU) © XCLAT) 
CCFac = CoSickac? 

OFLLAT = ( XCTIT(J) = ACLAT » #CONV 
CELLON |2(YCTLU(L) © YCLON ) @cONV® CCFaAC 
XTL(J) = *MELLON@COSTHT © DFLLAT® SNTHT 
VTEC DELLAT@COSTHT © DELI ON®SNTHT 

GO TO o! 

Cant TNuF 

JTGTS 2 J = 1 


SUFROUTINE WNOCAL (VWRe THETA) 
FOR A GTVEN wANRFOM WIND VECTOR CALCULATES RFSULTANT wIhD VECTOR 


COMMONS TOPR/SIN AT, ISUG 

COMMON ;WNDPO,WIKD, SGWP,SHR,SGSHRP,SGW,SIGSH2, SHRST, 

MOCALs NSAMEe MCNOY, NRPT) 9 kNSAMP oO ISTRATS TURGI eWMNOS, TUES 
eSaALeCaleVemucn 

DOMMON? WENPERY v1 04 (700) oF 1SSA 1700) CEPA (200) HORA SAND) .TWe AI 200)» 
NELAL2NO; 9 xyhl29N) oe YwA(2NM) © AWLAT (C00) eY¥aLON(29%), 
KCLATeVCLON ce AQGYS (700000) edwert (2nd) 


2 WTND@wIND © VWROEVWR = 2leWwTNO®VWR® COS(THETA) 
V = SQPT, VSG, Dreger Lee fh Kettle hid eT y 3 eat: 
« VwRe SING THETA) /V re © aan ap crtant h 2hic a “acre a 24 act A Lan re te thd 


SORT yo = SAL#3SAL) J 
TOMO 2VWROVamMe (VOY © WIND @wrand) 


lei TEMG .GTe 14) Cal & ©CAL 
TF (§G54pe Fue 0) Gn To 42 , ty 
SuM 5 0% > ng kel atin how Fcaeve ‘se 
— $3 Soe, ele Per ey rs 4 lige [heel f has 
SUM = SIM 6 wane (0) Ce ue ‘ 
ContinuFr 
SmO2 = SwRSOT © §7GSRCe(SUM © 4,,,/)2., 
IF (SHR .LTe yo! SHE = ge 4 
CONTINUE 
Tec rauG .Fu. ay GO FO 4§ / 
RITE Nt ego) Tee ToevaheVeSAL otal Ser 
FOROMST(SHOe® 251 G ETH THETA veo V Sal mar Samos eFleey 
Cats ENUF 
cate WELaSSiFten eee* le le 7. wa ag 


we ey thal ed 


he 


as 3 » 


33 


36 


32 


5% 


38 
37 
35 


c 


aeee@ (jNCLASSIFTEN ##0@ 12/14/76 PAGE NO, 00u 
[See 7 
IF( MONOY eFU. 1) GO TO 3) 4 OD gras fr 
Oo 32 1 w leIMaXx pore 8 “ashe 


00 33 J = led 

ARRYT(J) = ARRYA(T,J) 
CONTINUE 

IF (MQCK eE@. 1) GO TO 51 
CaLL FalyPwt Vv, SHRe ARRYT) 
Go TO 52 

CONT INUF 

CALL QFALFW ( Vz» SHR» ARRYT) 
CONTINUF 

Do 34 J a 1919 

ARRYA(I,J) 2 AQRYT(J) 
CONTINUF 

CANT INUE 

GO TO 3a 

CONTINUF 

00 36 J # leo 

ARRYT(J) = ARRYA(1leJ) 
CantIQue 

IF (MQCK s&U. 1, GO TO 52 
CALL FALLFW(VeSHR»e ARRYT) 

GO TO 54 

CON+ INUF 

CALL QFALFW ( V_ SHRs ARRYT) 
CONTINUE 

00 37 I = l,ImAy 

00 38 J = 1019 

ARRYA(1,J) # ARRYT(J) 


hy ¢ fn ee 


CONTINUE 

CONTINUE , 2. 
CoNTINUF : : 
RETURN conte Pa ful xf, 
END sik , i 


SURROUTTINE OSTCL (KeKT) 
COMPUTES DOWNWTKO ANO CROSSWIND OISTANCES AnD CALL FALLOUT OUTS. 


COMMON/WPNPR/ vLDA(200) oF ISSA (200) sCEPA (200) sHORA (200) »TWPNA(200) 9 
1 DELAC290)5 xXwA(200) 9 YWA(2N0) 9 XWLAT (200) pYWLON(200) 4 IMAXy 
2 XCLATSYCLONSARRYA (200940) sarpRYT(200) 

COMMON/ tARPR/ XFL (50) SYTL(50) eUTGTIeXACTLT (50) 9YCTLO (50) »NAMEC (5042) 
COMMON/WNDPR/WIAD » SGWP 9 SHR eSESHRP9SGWeSIGSH9s SHRST, 

IMoCaLs NSaMPe MONOY, NRPT 9 XNSAMP eISTRATs TVEGI »WMNOR,IDOEGC 

2 gSALeCAlLyveMQcKk 

COMMON/STAPR/ XLBV(51)eNR (50950) 9NBL(50950)e NBE(1019S0)>+ 

1 BE(102)6 MMAX(30)9 SO(50)e SOS(50i¢9 

2 SDC(5), SUF (EO) AV(51) sNBOXAeNBOXL pNBOXE .OMOST eNNSEV 

3 sDTOT eS SMLO0Se8e0 (80) sSSO0S (Sn) »SSOC (50) »SSOF (50) 9 NSML (50) 

COMMON/ TOPR/INeN1I ¢ IQUG 


XX 2 XTL(KT) @ XWA(K) 

Yy = YTt (KT) © YWA(K) 

ROWS) ESS bok. © vtroee 4% Sit. ene ind 2 ern 
YOW eXx*SAL ¢ YY®CaL LT Deer wit Bred Cee te » 


eaee NCLASSIFIED see. ; 12/14/76 pAGE NO, ne 


onto Not 12/16/76 -: 


t- 


EQ. a; SO TO § 
. 
SOs xr iatyerT 


aQire, 3 KT) UWA (KR) pYWAIX) pg XAZTV OX Dwyer 

as FORMAT (In 9@ nealG FON LIL IKT) oT TLIKT) pAWa le) opYWO(K) HKD TOD 
¥ BFL 204 y/e% AKO XTwHYDe My 2F 17.4) 

25 CONTINUE 
CO 41 4 = lelY 
ARRYT (J) = APRYalKe)) 


. 
, oe 


bd 


#1 CONTINUE 
IF (MQCK Ey. 1) GO 70 42 ee 
CALL FALLDW( xMWeMDCALe TwPNA(K) 5 ARRYT) 2 AS 2 bath 
CALL FALLCW(YCw.»MOCAL eARRYT) 2, 
GO TO 4a 
+2 CONTINUF 


CELL GFALOW(ADW,ARAYT) 
CaLL QFalcwt YeweaQoYT) 
CTOT = ATOT © aBkRyT (13) 


GQ To 39 
a3 CONTINUF 
T= (MOCAL ,NE.M) GO TO 47 
OTOT 2 ATOT © ARRYT(33) 
G TO 4a 
“? NT INU 
(MOCAL eNt&e 1) GQ TO 48 y, 
Dray s nTol * asaRRYT(38) ~ jun Lire 
GO TO 490 
44 CONTINUF 
DTOT = ATOT © ARRYT(39) 
ay CONTINUE ye 


Te ({T8uG .EW, ay GO TO 65 
WOITE( NIe96) ARRYT(93) 9 ARQYT(3A) 9 ARRYT(39)¢ OTOT 
rere FORMAaT( 1H s@nEBUG FORK ARRY 439 2AF 39% ANN NTOT®, 4F 1204) 
TF(18y6 .EQel) Go ta 57 
00 «SR ikX = 1,40 
WRITE(NTeG9) UxXe APRYT(UXX) 
a) FORMAT( ln «6 1109 F2U00q9) 
35 CONTINUE 
ONTINUE 
ONT TINUE 


j =THRN 
| 
* SUHROUTINE QUXEL (KT) 
f 
p * e DAES THe CMORF AF ACCUMULATING TRE yvARTOUS STATISTICS 
s 
% 
* COMMONS EO TAPRO/ XL SV (51) oNR(50050) 9N8L 150950) 5 NRF lUleS9). 
é 1 BE,102), MAX (50), SU(50)»9 SOS(S6), 
> SACISA) 9» SUF (EQ) o8V (57) NBOXAPNROXL ONBOXE eUMOST yNASEV 


3 eMTOTHSML UNS eSED (60) #SSDS (69) sSS0C (50) #SSpF (60) » NSML fs 
COMMONS VY PNP ey yi 0A(200) wFIgsé (200) «CEPA(290) sHORA( 209) y> 
TAFE A 2AH) 6) KWAL290) 6 YWA( 20H) 4 XWLAT(200) eYWLON(200 » 
KCL ATOYCLUN AeBY 4 17990,0) oqveyt (200) 

COMMONS pAQpuo/ eel (57) oe ¥TL E50) eT ST oeACTLT (50) eYC TL 4159) AME OC (S0,2° 
TAMMON SNOB Os WIAD yp SAWP SHR Gg SECHRE Oe SGWySIGSHE® SHRST, 

IMoCale “SAME e MANR VY, NHOT 9 enSaMP sISTRATOTUEGI paMNNO, TOL GC 


uv 


# 
i 


ra) 
2 9 whl ag VeMitt 
4 JSOBR/IN,AT, TRUG A 
§ * 
y- 66% NSLASSIF TES aeod Leos leas7a% & ‘ 
o. 


~~ ae - « oe © wee 


ell 94 


13 


ol 


65 


36 


SS ee 
f 


ales BRB & nits Le Legg HP AR 


oa 


2, 


- 


} 
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SO(KT) © SD(KT) © NTOT 
TMA = DrOT*OTOT 

SOS(KT) 2 SOS(KT) « TMA 
TMB = TMA®OTUT 

SoCc(KT) = SDC(KT) » TMB 
TMC = TMBOOUTUT 

SoF (KT) = SOP (KT) # TMC 
IF(DTOT eL Te SMLOOS) GO TO 7a 
SSO(KT) 2 SSU(kT) « OTOT 
SSOS(KT) 2 SSUS(KT) © TMA 
SSOC (KT) = SSOC(KT) © THB 
SSOF (KT) a SSOFIKT) © TMC 


GO TO 73 ra 2 
CONTINUF be - t 
NSML(KT) = NSML(KT) © 1 ~~ phe when # ; 
CONTINUE were” Lip Saneneroet 
IF (OMAX(KT) eLT. OTOT) OMAX(KT) 3 OTOT 

Oo 61 JY @ LeNROXL 

IF t OroT .bE, XLavViJ) ) GO TO 61 

NRL (JeleK7) = yRL(celeKT) © 1 

GO TO 69? 

CONTINUF 

NBL (NBOXL »KTI = NOL(NSOXL,KT) © 2 

CONTINUE 

Do 63 Jel, nReXxA 

Ir ( OTOrT ,GEe aviu) ) GO TO 43 

NB (Jey, 9KT? = NA(JezpeKT ) © } 

GOH TO dy 

CONTINUF 

NB(NBOXAsKT) # AB(NROXASKT) © 1} 

CONT INUF 

DO 65 J = 1sNBAXE 

IF(NTOT eGEe ae(J) » GO TO 45 

NRE (Jey oKT) = NRE (Je) oKT) © 4 


ace 


Go TO 66 

CONT INUF , 
NBE(NBOXE,KT) a NBE(NSOXESKTY © 1 Zid! alec ra bor bas 
CONTINUE é wna! btpae Of Ate rasate 
a ES as 

ENO 


SURROUTINE wWRTLST 
PERFORMS THE FYANAL QUTPUT OF DOSE STATISTICS FOR EACH TARGET 


COMMON/STAPR/ XL8V(51) eNR(S0950) 9NBL(50950) 5 NRE( 101950)» 
2 SOC(Sare SUF (50) oPV (51) sNEQKASNBOXL »NGOXE »OMOST »NOSEV 

3 CAUSA, net tet liber galular oe gah ng iad ay NSML (50) 

COMMON/ pApPa/ XFL (50) oYTL(50) eJTSTSeXCTLT (S50) e¥CTLO (50) eNAMEC (5092) 
COMMON/TOPR/INeNI 9 TRUG 

COMMON/ WNOPR/ WIAD SGWP 9 SHReSGSHRP#SGwWeSIGSH7s SHHSTs 

IMOCALe “SAMPe “NOY. NRET oXtnSaMP eo TSTRaTeTVEGI #WMNDRe IDEGC 

2 pShbe Cal yyeMylX 


DO 101 *T = lestGTSs 
@e@e INCLASSIFTEN #08- 12/14/76 PaGe NO, 0 


| 


i BS. 


ag 


NSSuM 
N,) SUM 
N=Siim 
WRITE ,N?, 77) 


OQ 


t/ FORMAT Ly Ry) a a es 
WRITE( MT y 74) fit aad | 
Fe FORMAT (1HO) i 
TF (TOEGC Ene 1) Ga To 91 
WRITE NY, 73) KT, XTL(XT), YTL,KT 
5 FORMAT (y Hae eureT]oaUTIONS For TARGET NO, [29 * LNCATED®s FJ yg.de | 
1 @ STaTuTe MILES HOWN AND®® £10029 © STATUTE MILES gcPOSS FROM Tr 1 
2E CENTRAL Axlsa) 
Go TO 95 
wy Cant [NUF 
WRITE(NTS93 ) NAMEC(NT0]) 9 NAMEC(KT02) 5 KTo ACTLT (KT) aYCTLOMKT) » 
Ti STeKkEye YOK) 
93 FipMATiVHOs © CI gzpoisutloNs Foe THE TARGET @, 248, © NyMbEWVED 
1 gfae/s ® AT LATITHNE % Fina 9% VEGREES “ORTH ANN LONGITUDE 7s 
2 F1Mey 9 © NEUAEES vEST®e/s @ LOCATED®® Fl%e2s © STATNTE “MILES 00 | 
twN AND os F10.2, © STATUTE MILEs ACROGS FRIM THE CENTDAL Axio Te | 
92 CONTINUE pee so i 
WRITE (NT 9 75) OMAK GKT) fappitpime sr 
a FORMAT 140, @ THE MAXIMUM DOSE s® F13.4 ) Pe ¢; Dies 5b eae 


KMN = SN UKT) unig Ame , 
XMNG = XYMN@XMN i! 
XNUS = SES(KT! s¥NSamP 
WAR = XMNUS @ KMaS 
STO = SART( VAR) 
XNuUC = SOC(KT) /XxNSAMP 
Skw os (X¥NUS © 4, PXNIIS@RYN © 9, @KMNSPXKMN) / (2, ®VAR®STDO) 
KNUF 3 SOF (KT) /xNSAMP 
KXUDa( YNUF = 4, @XNIICAXMN © 4, @XNUSPXMNS © 26*#XMNSOXKMNS) / (VAR OVA) 
WRITE (NG eo PQ) AMA STO og SMW yg XKUQ 
ie FORMAT (THO esUCSE STATISTICS em MEAN = #8 Fl %e4s? STANDARU VeviIaTiIO 
N = #, FlO.4e © sKEWNEss SPF 10649% KiyppOsls =e9F 10,4 ) 
Ie( NSM (KT) e@Te %) GO TO 4} 
WRITE (N1T942) SMLOIS 


a2 FORMAT( 10, ,» NO POSES LESS THAN oa, Fl0.2 ? 
80 TO sae 

+} CONTINUE 
IS {NSML (KT) eGr,. 1) GO TO 43 
TeM0 2 SO(KT? @ SSK) 


TEMP. SL U0S 
26 FORMaT( 1HO, @ ANE NUSE OFS, £10.2 » * IS LESS THaN DOSE UF*) 


XNSML = NSML (KT) 
RNSML = XNSAMP o@ XNEML 
RUN SSSA (KTS KAOME 
AMNS = XMN@XMNN 
XQUS sSSNSiKT) sXNSML 
VAR = XNUS « XMAS 
SrA = SART (vary 
myUC eSeOC (KT) s¥NSML 
S<w oz (¥Nity © J, MXNIISOXMN © 5, @KMNSOXMN) (5. °VAR®STO 
RNUE =2Sere (KT! /XNSM 
re (Os) yr «© 4 PXNNCOXMN o me PXNUS@RKYNS - ae PAMNSOXMNE) Si VaROV AH 
WET TE NG eg 7) NOML (KT) OSMLNOSs XMNOSTO eS ay Xen 
«+ FAGuatT! 140, © POSE STATISTIAS EXCLUDING © ele © @ 2NeES 
FAD, © RADY wcehess LOK9 OMEAN & %yF 


“~ 


Dee © STAND AR ia 


04% NCLASSIFTFH o8e8 Les losre “ace 


“6 


71 


73 
72 


ol 


33 


65 


eacaeenaceeaeacackcn 


sate UNCLASSIF TFN see@ 12/14/76 PAGE NO, gdu 
2 @) Fl0.g9 © SKEWNESS = @» FINege * KURTOSTS = * 6F10.4) 13 
CANrINUF 
Ty wt monk of Pine? 


WRITE( NI_74) 
WRITE(NT® 71) 
FORMAT( 1HO, @ SPECTFIED BOXFS®///10X— 6H Ne 10%» 1OHMIN, VALU 7 
1E 91 0ve =1LUHMAX, VALUE 6 10X9 10H quMXER v10Xs 
2 10H CiiMLe NO, ) 
Do 72 J @ yeNunxA 
wa Je] 
NSSUM # NSSUM « NA(UeKT) | 
WRITE(NT#73) J 9 AVIS) » BV(GI)» NB(J KT) »NSSUM 
FORMAT( 1H 6 10X%— 14 9 120 IH) e 10Xe FlOer910X9 FIO.0» LIX, 
1 119 9170x9710 ) 
CONTINUF 
WRITE (NY eAL) 
FORMAT( lWle * FQUAL LOGARITHMIC INTERVALS *9////4 
1 10xe 6H NO. 9 10Xe LOHMIN, VALUE » 12xX- LOHMAx, VALUEe 
2 12X_, 10H NUMAER 910X9 10H CUMLe NOe ) 
OO 23 J = LeNenxl 
SS aS a} 
NLSUM 3 NULSUM « NAL (J,KT) 
WRITE(NT9Q4) Je SLAVIN) » XLAV(J)» NBL (J 9KT) »NLSUM 
FORMAT( IH 6 10X— 14(9 IT2e tHe LOXe F12.26 10X9 FL12,2e1UA0T10» 
1 o10xs 110) 
CONTINUE 
WRITE (NT*&S) 
FORMAT (IH1L9// 9@ FQUAL INTFRVALS#s //// 


~ vensem cave iti x 


le 10X09 6H NUe 610X9 LOHMIN, VALUE 210X%e LORMAX. VALUE e 
2 19X, 10H NuMPER 9l10X%* 10H CUML. NO, ) 

Oo Ab J & leNenxe 

df & J « } 


NESUM © NESUM « NRE (Je KT) 

WRITE (NT0Q7) Jy BE(J) 9BE(JJ) 6 NBE(U KT) eSIESUM 

FORMAT( 1H ¢ Lexe 2H (9 I2e 2H) 210Xe FlOe%#10X9 F1O0HL0X» 110» fp 

f TOCs tho 9) eet wondin [ siyese 


CONTINUF [ewreneee ins anes 


CONTINUE 
Re TURN 


ENO — 
SUBROUTINE QPAaLLY( YIELDeFISSeHO0ReQARRY) MIYUNS S7TANIAKO 


A RAPID VERSION OF THE WSEG 19 FALLOUT MODE! 8ASED UPON FITS 
TO CALCULATED NOSES RESULTS RE STORED IN THE ARRAY QARRY « THE 
BASTC ARRAY VAPTABLFES ARE 

LeeeYIEIO UVEPENCENT ALPHA FacTOR IN FD 

2eeceYIELO OFPENDENT SETA FACTOR IN FO 

JeoeA In SIGC CALCULATION 

4.008 IN SIGE CALCULATION 

S.eeFINAL HOM FACTOR 

6eeelF an VARIARLES IN INTERPOLATION RANGE» TF 1 THEY ARE NOT, 
TeeeVALIE OF wrAD 

Bee eALPHA FACTO IN FO 

Jee eSHEAR/WINU 
10eee2eSfGCeSiGC 

YleeeFD 

L2eee {7 (SQRT(2,P1)S1GC)) FO 

y3eeeMSEG ALOLOGTCAL UUSE 

19 © 19 ee USEN YN SYALL WIND OAR DISTANCE CAI CULATIONS 


oo%e §NCLASS Tp FD eee® i 12714776 Page NO, 1 


a 


A « (89, & (ee? 99° « Tels BA8QQY (146) ) OF Fw) SeC@sc 


ewe NCLaSSlFesn veeo Lésly ; oe 
CALLING SEQieNCE 5 SAME As wlth THE REGULA. MOOEL FxCEP 
GS UPTTON 


NMcsse nose 


YIFLD DEPENDENT CALCULATIONS 


OTMENSIAN wawky( 1) 

VARAY (14) 2 YIELO 

QaREY (6) = ne 

Tet YEECO tite ne) OMe YIELN .GTe 3ne) QARYY(6) 2 le 
XLNY 3 ALO’, y9(YTELD) 

TMP = XI NY®XLNY 

QARRY(1) = Se4tGe O,LO09D*XLNY © 020184TMP 

MARRY (2) ==0e0AG1l © UeOLII®XINY = 06003358 TMD 

QAPPY(3) = 2e © Ly 7ICI#XLNY «© 1.2691 9TMP 


QARRY(4) = 7e5q ¢ 7 eS71G*XLNY - 0033,4eTMP 
QARGY(5) = FILSS 

TF (HOR .GTe Ue, GO TO 5S 

RETURN 


CONTINUE 

AMMBSLS8 Ae O(VYIEL CPL rade) MP0 04 

Te (HO961EeAMm) GO TO ag 

QARRY(5) = ane 

RETURN 

CONTINUES 

TEMP =HO0R/ XMAS 

AFSC os*( 1 =TEMP) &(1 oe TEMP) 9(5,.°TEMP) 40,001 8TEMP 
qARRY(5) = Flse * AF 

RETURN 


ENN 
———— 


: (pede: FP ANGACO 
SURPOUTINE GFALFW( FF We SCyQ4URY) 


WthD DESENDENT CALCILATIONS 
DIMENSTIAN QARRY (1) 


QAROY (7) = Few 
IT \SPWelT. a0) GO TA 5 


. 
GARO’Y (9) = SU/FEW 

PARAY (Bs = QAaRPYi 7) = 96995941 9G,0 (EF) 

RETR «, 

CONTINUE 

QARRY(9) = SU 

DARRY(6) = 960 

WHS FS 1, = VeQeckw 

yAapyi lt) = (4,845 « 0,0745#ndaryil)) © (9,1222 » A,nn75% 


 QAPRY (14) yawHs [71,2222 . AN OP7TASGARRY 14) ) SC 

GARCY (ye) F OH, 2O4RK F Qe 9031 KSTARRY (14) 

QARPY (led sl Os yay = VeO2gggSQARRV (ly) 2(00a3977*% SolF2IeGarwyil,) 
1 ewes )00,U01 

QARRY 1a) = 3e7a © MeSLeGQARRY (14, | (0433% VeO3eUARAY (14) ) wt Fw 
1% §4209Se (740.0975 % DeG2aE*IQARRY (14) ) SEF 4) OSC 


DAREY 1a) 2 (3.ALL , 00039e7aRDY 14) ) —SC 

RETR, 

ZAR I 
([Sapbe. “th Raea 
fs bvuas sTAaDQAno 

3 PNuUT NE wF Si Dwi hw de GARQYY 


12,146,764 PAGE NC, 


aad 


1a 


20 


aa@e@ (NCLASSIFTFD ##e@ 12/14/76 
OOWNWINN DISTANCE NFPENDENT CALCULATIONS 


OIMENSIAN WAMRY 11) 

IF( QARRY(7) eL te 34) GO TO a9 

XSCL a nWO/QARRY(7) 

S1GC = QARRY(3) * QARRY (4) *QaRRY (9) *0WD 
IF(XScL eLT « 1.) GO TO 5 

XLGFD ® QARRY(A) © AARKRY(2) ®xSCL 

TUSE 2 2.5066eS5IG6C 

IF (XSCL .GTe 15.6) GO TO 19 

TMP = XSCL <= 1806 

XLGFO 2 XLGFU « genn]S*TMP* TMP 

CONTINUF 

qarpY(ln) 2 2,#eIGCesIGC 

IF ( XLGFO oLTe 28.) XLGFD 3 @8, 

QARRY (1) = QARRY(S) * 1 Ho #*XLGFN®QARRY (14) 
QARRY(12) = WARRY(11)/TUSE 

RETURN 

CONTINUE 

XLW 2 ALOG1N(QARRY(7)/206) 

OFLTN = 36 © 5.6*XLW 

FACT 2 56 © ALNG10(QARRY(14)) 

DELTA = DELTN#SFACI 

XLOMEN = 30355 © 0.380aXLW © 0.275 ,QARRY (9) /QARRY (7) 
XLDMX = XLOMAN ¢ 026448*(FACT = 1,) 

OwOs = NwO*FACT 

IF ( OWNS eLT. NELTA) GO TO «4 

XLGFD = XLDMA 

TUSE 3 y6 

GO TO la 

CONTINUE 

XLGFD = XLDMA© (DWNS@DELTA) *(NWOS*NELTA) #027169 
GO TO 1A 

Conti Nur 

IF( DWO .GT.05. )GO TO 21 

XLY = AL 0G10 (QaRRY (14)) 

XLDMX = 4.35 © AeSH6eXLY | Oe L2%°QARRY (7) "9901 5%QARRY( 9) 
B0T = O76 * 2e7.PALNGLO(QARRY(14) ) 

OUSF = 9.5" QARDYI7) = OwD 

XLGFD = XLUMA _ DUSE*#UUSE/80T 

GQ TO 22 

CONTINUF 

XLGFD = QARRY(7S) « GARRY(16)@NWD «© QARRY(17) *OWO*DWD 
IF (QARRY (17) eLTe 17.&°8) GO TN 20 

BETA = 01. *QARPY(36)/(2.9QARRY (17) ) 

IF( OWO .GT. SFTA) XLGFD = eg, 

CONTINUF 

SIGC = pApRY(IRY + nARRY(19) eOWd 

TUSF @ 1. 

GO TO Ia” 

END 


SUBROUTINE QPFALCW( CWUsQARRY) 
CROSSWINOD OLTSTAKCE NEPENDENT CALCULATIONS 


OIMENSION QARRY(1) 

TMP = CwOyCwUs/9ARRQY(10) 

Ie (TMP oGTeos%e) Tmo 2 aOe 
Q@ARRY(12) = yAoRY(12) Exp (eTp) 


eee UNCLASSIFIED #@at ~*~ 12/14/76 


pAGE No, 09 


15 


eres 
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] 


1 IVER 1e 20S AO NOT REPEAT CALCULATIO® Vsamant Data ice 


Sannd, su La, VALHES OF DMOST "10S EV ANN svLuos 
2n6 003 +? Me VALUES OF WIND S1Gw OnR 51Sr 
ny 100v0 0 1 MNCAL “iSAMP YSTRAT MuCK 
nef SEFD iF 9 USE CLUCK | 
mete one Ine + DEGW MNWAN LATC LONC CIT ?DEs 
te te Qe Ne beg ued Qeg YFATOXY 
“le : ENT wo Rn | 
220 Ne XTaAR YTAR ] 
40.0 ne xTAR YTAR | 
Onel De XTAR YTAR 
th. Ae XTAR YTAR 
15020 ne XTAR YTAR 
4009 lhe XTAR YTAR | 
3000 2ne x?aR YTAR 
4069 ane XTAR YTAR 
¥9939999. END TARGET READ 


COMPUTER PROGRAM DESCRIPTION 


NAME: LASHCO 

SYNOPSIS: Produces Grid Fallout Risk Output 
TYPE: Semi-Production 

USE: Version of Lash to Plot Contours on a Grid 


BACKGROUND: Dervied (in 1973 & 1975) from Program LASHTX 
Which in Turn was Derived from LASH. Used for 
Contour Plots in Colorado and near San Antonio, 
Texas 


Modification of LASH to put Monitor Points ona 
Grid and Produce Magnetic Tapes 


DESCRIPTION: 


INPUT: LASH Data Plus Weapon Locations 
Card Deck #115 


OUTPUT: IDA Runs #53, 54, 78, 79. 
Tave Input to Program COLPLT 
STORAGE: IDA Card Deck 113 


DOCUMENTATION: 


LANGUAGE/SYSTEM: Run(FORTRAN)/6400 SCOPE 


COMMENTS : 


COMPUTER PROGRAM DESCRIPTION 


NAME: COLPLT 

SYNOPSIS: Plot Grid Fallout Risk Data with Calcomp Plotter 
TYPE: Semi-Production 
USE: Uses LASHCO Tape Output to Plot Data 


BACKGROUND: Supplementary Program to Program LASHCO | 
DESCRIPTION: Produces Fallout Plots Using IDA Calcomp 
Plot Package | 


INPUT: LASHCO Tape 


OUTPUT: Calcomp Plot Tape, IDA Listing #50, 53, 54 


- 
Z " 


STORAGE: IDA Card Deck 116 


DOCUMENTATION: 


LANGUAGE/SYSTEM: Run(FORTRAN)/6400 SCOPE 


Se eee eT re eT TE 


t 
& 
4 COMMENTS : 
Ls 
: 


% 


r 


7 COMPUTER PROGRAM DESCRIPTION 


NAME: RUBATO 
SYNOPSIS: Nationwide Fallout Risk Calculation P 
TYPE: Production 


USE: Computes Fallout Risk Statistics Both for Exploratory 
Purposes and as Input to ADAGIO Evacuation Calculations 


BACKGROUND: First Developed in October 1973 on a Crises Basis 
to Provide ADAGIO Input for CRP Calculations. 
Used LASH Program as Basis. 


DESCRIPTION: MONTE CARLO Simulation of Wind Statistics. Uses 
County Population Centroids as Monitor Points. 
Several Bookkeeping Features Including Distri- 

+neor butions of Casualties & Fatalities from Fallout. 


OUTPUT: IDA Listings 37-44, 103,109 
STORAGE: IDA Card Deck 92 


DOCUMENTATION: IDA Paper P1065, "Methodology of Fallout-Risk 
Assessment" Leo A. Schmidt, Jr., Jan. 1975 
Attached Description 


LANGUAGE/SYSTEM: FTN/6400 SCOPE 
FTN/3600 SCOPE 


Version Somewhat Different than Current IDA Version 


é 
; i COMMENTS: CDC 3600 Version Used Extensively at DCPACC. This 
* Due to Different Modification Requirements. 


The program RUBATO was derived from the program LASH 
and is identical in many of the basic portions. Many of the 
variables have the same names and meanings. The first por- 
tion of the program RUBATO contains definitions of all signi- 
ficant variables. 

The program was structured so that it could be expanded 
in several directions--primarily a better handling of relations 
between WSEG-19 model and cluster models to give better geo- 
graphic resolution of the results, the capability of handling 


more realistic wind streamlines, and the capability of appending 


a blast fatality calculation. Unfortunately, time was never 
available to include these various refinements. The program 
} is thus, partially completed, but has been used extensively 
for production calculations. The version presented is the 
current IDA version. This differs slightly from the DCPACC 


version. 


The program has separate parameter input with the 


I subroutine INVAL and descriptions of parameters in the sub- 

- routine PAROUT, as compared to LASH where the two are combined 
be. in PARIN. The input variable meaning is clear from the variable 
hy descriptions in the start of the program and the program LASH, 
le except for the following remarks. 

le The switch IWNDST is only implemented for options 0, 

Le common statistics, or 1, use of the nearest monitor point as 

be input in the wind statistics input at the end of subroutine 

if 


INVAL. 


The switch IWLVSW is only implemented for option 1, 
linear winds relative to the target. 

The switch ICLSA is only implemented for option 1, 
weapons in clusters. These three switches allow for the 
types of calculations described in P-1065. 

Activating the switch IFRCRS allows fallout fatality 
statistics to be developed. With each wind sample, the 
numbers of fatalities at the monitor point is calculated 
and statistics concerning fatalities are accumulated. It 
should be emphasized that without a blast fatality model, 
the fallout fatality calculations may be biased. For attacks 
in urban areas, where blast fatalities may occur, the effects 
of wind variations are less severe than in rural areas, where 
no blast fatalities generally occur. 

The basic control of the calculation is in the subroutine 
MONTE. In particular, this subroutine generates individual 
winds, does the weapon screening, and calls the fallout dose 


subroutines. 
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ete UNCLiSsiF IED ##¢e 12/14/76 PAGE WW, 00 
PROGRAM RUBATUCINPUTSULTRL I sPUNCHs TAREA® TAPEN. TAPECs Fapeu) / 
sewotaeaee30 4/69 ( CoMPATACILITY CHANGE ¢eeeetvoneoweos 
PRUGRA* SUpaTY 


TEMPORARY VERSICN OF OCTe 39 19736 
SLIGHTLY FEVISES IN SEPT. lo74 


A PROGRAM WHICH CONSIDERS TARGETS ONE aT a TI“E Iw a VARIETY oF 
WaYS aNuU THEN PRODUCES NaTLONWIDE SUMMARKIESe 

DOES a MONTE CanLO calcuLaTION OF THE pIsTRIauTI0N OF nUSES FORK 
CIRCULAR NORMAL RANDOM alu VECTORS 


ULIMENSLIUN ILA’ 2? 

COMMON/RUNSW/ICT3 CBs ISL e iCLUSTo IST NGWOLABEL (2° 92) 91 SPWSmweILGwSae 

LIEVwsee: MOST #NUSE Vs TnSaseeLLyS#*UUSELY (5) gfeHoSazeKOLV (3) 1 1CATons 
> MOSTPSMLVIP wmP EP, PCL Say MEST, RESTA, JREST A, RESTO, URESTE, URESTF, 
IFRSKe LUMASsVSaMPe [STHal oLAnOST o LSwkSwe [aL VSnsMucns SEEDS SEEDS 
SOS oCSEEUs LF RCAS giWPFL WV oPFLVU(T) oPFLVR (7) 9EDSEMsFOSESGSCDSEM 
CUSESG*MOCALSICLYLOSICLYLWeFRHFUC!) sFRRFR (7) 

Ae TLSICTs® LSTLV(TU) oLCTLN 4190) @LSEAS STI WeNSTIN 


2 U eb 


RUNSa@ CONTI ANS CUNTROL PAFAMETERS DEFINED SY [NPUT DATa 


INPUT CONTROL PakaMETEXS 

ICTYCoe= USE NNMN CULNKTT Calas Cy aND CT RECORUS FOR TaRUETS~ 
LIF NO ECR eS AFTER EACH STATE 92 IF THEne IS 

Tat%Ten 9 scp TNPUT OF Tahgel vaTay 1 alNarty [NPUT, 

ICLUSTe= EAEKCISE CLUSTER wEAPON I. .PUT 

ISINGwee EAgMCISE SIvole wEaPON TNPUT 

IcLtlues IF 7 USE avenave YIELO aS rNPUT FOR USE IN CLHSEGs 
IF } USE 4 SINGLE YIELU FOR ENTIRE CALCULAITIUN® FIKST VALUE 
INPUT, iF 2 SeLecT FROm UNE OF SEVEN CLASSES aS STanpaRy, 

IF 2 SELECT CLASSES AS WEAPONS ARH TPUl 

ICLYLQ©* 55 [CLYLD pul FOR USE WITH WULEN wSEQ ROUTTAES 

ILSTcie= Le ! iNclLUp_, STaTES 1M TST{Ne2 Owl CTYe> pw IcTIN 
PLUS ALL oF ANY STATES IN ISTIW 

LSS AS os LIST GF SiplES TU c& UdED IN ge FURMagI 

NST [Nel NU4HEM Of STLIES FOR USE 

IcTIiw' G9! 22 LIST UF STATES ANU CNIYS. FU HE YSED IN Ageng 

NCTI Nes NUMMER Of STale COUNTY COMGINaTLUNS TU YO 


UUTRPUT CONTROL SARAMETERS 
Lasebe= THO Bo ChAXaCTER LINES CE «TERED Ur TITLE Packe 
[SkaSwee aRITE vost Level SPECIFIE) Iw ARRAY Dve 
LLGwswee weTIE LOSES «aT LOGARITHMIC InTERVaLSe 
IEV4Swee wayfe LOSES »T EVEw INTERVALS 
UMOSTes DOSE LEVEL af FiGmMEST UF EVEN INTE SVALSe 
NUSE Vee NUMBER CF Even INTERVALS»  IMENSION LIMIT OF 5V0. 
[HSSWee WHITE HISTOGR**S OF DUSE DISTRIBUTION? 

ILSFSwe= LF One OUTPUT FATALITIES» caSUalTIES aNy DOSES FUR 

INYTVIUUAL SAuPLES 

ILVSwee welTE PROpaGILITY OF MUSE VT SPECIFIEL LEVELSe 

VOSELV(S)*= SPECTFIeE> LEVELS FUR DISSES 

IPROSwe= wRITE GoSe AT SPECIFIED Pow LEVELSe!S, 50, 90 jp | 

PKOLVIS)e= [TF TPRUSa ® © USE THESE TweuT PROSAHILITY LEVELS 

[LaTower wap fe in FORnme! FOm CATAGURY LEVEL OvTPUT 

Ay STReeaR IT Te taPe Ow Wo MITA CUSE iN SPECTFIEU Rav 30%ES 

MLViPewe waite Tape vo si TH NUMBER oT SPECIFiEU PERCENTILE PTS. 

MMP Tree WRITE EACH DUSE CLMPUTED YU Ne- 
I-37 


eee UVCLoSSIFIEL #eee VeslesTo Pavt NO, 00 


WWE 7 
WECCAING Kiroe BLAWH - - Led 


—- eee eel ete net env 


#eee UNCLASSIFIED 298 12/14/76 PAGE NO, 06 
15GNe5~e IF SENIE Setlcn 1 Sel DUMP on var TaPe NG ue 
JSGnee IF SexSe€ Salton 2 SET KESTaxT FRUM pUmMr TAPE NGe 
KSGnt] If SENSE S#lTcom 3 SET DISPLAY CURRENT COUNTY ON CUNSULE 
JREST|e CUNTSULS PUSTI [UNS UF TAPES 0. RESTART, 9 ate TAPES 

AT de 1 Auve TO _URESInNvETC.92 AVY TO YumP TAPE vALUE. 
PUSTTIVE TNPUT Take ONLY sNEG, LUPUT aM yOSE TaPes 
AUVANCE OCSE TAPES TU EOF iF JREST = 2 
JRESTN©= \UmMBER OF TARGET (WUTR) Ta RESTART WITH NEw TAPES. 
JREST Awe RECORD CUUNT UCN NA 
JRESTp|e= RECORD CUUNT UN ND 
JRESTE Se RECENQ CUUNT UN NE 
JRESTFee RECORD CUUNT ON NEF 


RUN CONTROL OPTIONS, 

LFHShe= PEKFCHM F,~_LLUUT RISK CALCULATIONS. 

LOMaSe= PERFORM paMace wSSESSMENT CabcCULaT UNS. 

NSamPee NUMBER UF SmuPLES FUR Each Taxcel 

[STRaTe= IF © USe REGULAR SaMPLInGe If 1 USE STRaTy Ee IED 
SHMPLINGe 

[wn Stee 0 USE INPUT V,LUES penne ange SaaP FUR EenTIRe 
CaLcULaTICN, pr 1 YSe MONTTOR pata POINTS at FLaT’Y, ETC, 
FOR AVERSGE w[iiD UATA AT TakGET>*® [F 2 USE ALGORITHM 
TO COMPUTE VaLUES aT Each TaRGETe : 

TSeas\= SeaSun FOR wey STATISTI CSe lew[iiTeons 2=SPRNG» 
Seaummens FF OLLe PeAVERAGE AnnuAL. 

TSHxSwee LF_' USE CONSTANT SrttAks LF] USE 172 NORMAL 
ULSTRT SUT ION WITH mean ZERO anu ST DEV = SHRST@SG>HRP, 
IF 2 USE FULL NORMAL WITM MEQN SHRST atin STOe UFVe = 
SrHRST*SGSrHPe 

T4LvSWee (Fo 7 USE ACL FORTZONTAL WIND, IF 7 USE LINEAR wiInoS 
PELaTIVE TO TakGel, IF 2 YSE PataBOLIC wINUS, IF 3 USE wIND 
COOROINATE SYSTE4. > AND 3 NOT IMPLEMENTED YETe 

[cLSae= [F Y USE INO[VIUUAL WEAPONS InN alNaLYSISe lf 1 USE 
ONLY wEAPCNS yw CLUSTERS® LF 2 GSE COMsb,NATIONe 

muCne* IF u USE PEGULAR WSER Llu CALCULATLONS» 2F | ysE quicn 
aPPROK IT, ) [ON 

MuCaLe=s [F » USE W>dE0 GIO DOSE ONLY® | NMCSSC o1O* IF 2 
abS0 CUMPLTE 9 Make FORK REGULAR WSee 1D FALLOUT EaALCe 

ISefUT= IF & USe CLUCK FUR SeEDe Te 1b USe PMPUT VALUE FOR SEED 
FUR RANUQ + NUMBER GENERATOR: 

SEEVe* LaPUT See, IF sce = 

4aUSM%e= USE SamE SEE FUR EaCRH TARGET 

CSEEDT] VoLUs OF Seeu TU USE FOR TaRgETS yr MSoSw = 1 

EFRCaSe* IF fo yu FaLLuLT PISK CASUcLTY CALCULATIONS. 

MPPLVTe NUMKER OF PROTECTION FaCTOM LEVELS TO aSSUme 

PFLVU(7)©© FE VALUES PCR URBANIZED akeayes 

PEL YK IT) e@= FE VALUES FOR NOW URBANIZED AREAS. 

FRPP R|e@ FHECTION aITR URAL PF LEVeL 

FRPFUse FRACTION alTr UnSAN PF LEVEL 

FUSEMes Meath FATALITY FALLOUT DOSE 

FUSESG== STL VEV, UF me AN FATALITY FALLOUT DOSE. 

CUSEMme MEAN INJURY FALLOUT DOE. 

COSES¥e= STL. DEVe ON HEAN INJURY FALLOUT nOSEe 
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COMMON/KUNPR/ ANSOMP oNrr TS ONSMPCT oILAST eT STNOgISTLUSUSTCUSUSTNMy 
e : Y TSTC(31) LST NM (FL) @LCARRY (100) PMSEPLT o 1 ISEPTeAPLTOYPLT 
29DSEPL ay DSEPLo yi SEPL Co LSM ING yp USM IG yh AFATU FAC ASU FRE ATX FRCASR 


s c RUNPR CARRIES VARIOUS ParkseMETERS WEEDED WOT TvPUT DaATa, 
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eaee NCLASSIFIED e¢ee 12/14/76 PAGE NO. Oov 
ANS AMP] FLOGTING PULINT NUmOER OF SAMPLES. 3 
NAPTSe— NUMER OF Times AT EAC LEVEL IN STRATIFIED SAMPLES. 


NWSMPCT#e CURRENT WUMpgk OF TRIALS IN NONE STRATIFIED SaMPLES. 

ILaST*= Flac TO INUicaTe LAST TaRGeET waS BEEN PROCESSED. 

IST\US= NUMBER LN OHDER OF CURHENT STATE Be iNe PROCESSED. 

L5TL Vee AUMAER IN LOUNUP ARRAY OF CURRENT STale 

JSTCLe= CULE NUMBER OF CURRENT STate FRUM LOOKUP aRRaY 

USTNM@= NAME OF CURKENT STATE FROM LOOKUP aRRaYe 

ISTC(Sh) = LOOKUP aRHaY OF STATE CODES IN 74 CENSUS, 

ISTNM(52) se LOOKUP AnnAY OF STATE iWAMESe 

ICARKY(1QC)e= POINTERS @IVEING ORUVER IN WHICH STATES ARE 
PROCESSED, VaLUE IN ITH, ENTRY 1S Place IN I1S™TNy Up [Ty ST, 

DSEPLT@= VaLLE UF DUSt TO USE FOR “aP PLUTTING 

LuSEPT|#= INDEA UF OUSE LEVEL TO USE FUR Hap PLOTTINGe 

APLT*#" A Value IN INCHES FROM MAP CENTER® 

YeLTo= Y valle IN INCHES FROM MAP CENTERe 

FrFatee FRACTION #IIh FATALITIES FUR CURRENT VOSE 

FRCaS*= FRACTION wITm CASUALTIES wiTh CURRENT DOSE 


COUADNACESERE YLDC (500) #F1SSC (500) oXWC (590) 9YWwC (500) »SIGAC(500) » 
1 STGYC (200) eNCLS9SARY (20007) oYLOL (7) YL Dm (9) 9 ARYL (7919) 5 
PARRY (7, 40) 


CLSPR USED TO STORE DATA RELATED TO wEAPON CLISTERS 


FISSC** FISSIUN FRACTICN FOR CLUSTERs = TOTAL CLUSTER 
FIDSICN YIELO / CLUSIER YIELD VALUE USEn 

YLOCt=wEAPON YIELOeMTe THIS IS THE AVERAGE WEAPON YIELD USED 
FUR & TYP[CAL YIELU VALUE IN wEaPOw EFFECTS CALCULATIONS. 

Kace* EAST WEST COORDINATE OF CENTER OF CLUSTER 

Ywoe* NOKIA SOUTH CUCKDINATE OF CENTER UF CLUSTER 

SIGAC#= EAST WEST STanrARD VEVIATIUN OF CLUSTER 

SiGYCe= NURTR SOUTH SILNDARD DEVIATION OF CLUSTER 

NCLS*= NUMBER OF CLUSTERS 

SARY*= USED TO STURE YIELD VEPENDENT valL¥ES FOR CLUSTERED 
“SEG ° 1 FALLOUT wHCuEL 

YLOIT|S MEBN VaLUE UF TLELY FUR GROUPE, YIELO CaLC¥ULATIUNS» 

YLowe= SeFeralINg VaL¥eS FOR YIELD INTERVALS 

waRflLee TU SIOKE YleLuy LEPENDENT VaiL¥e OF YIELD INTERVALS 
USED IN QUICK 4SEG 19 FALLOUT CaLCULaTIONSe 


COMMON/TARRRS NAMETROL.) oe TRPTs TRPUsTRPRG TRPUA,IRSOTCO*IRCUCOs 
i TRUAC g[HEAC, ISMSAC wNUTHs TECGLAsTRCGLOVVIL GALL SIGTRUSSTGTHL® 
cal TR NECCS, NMCUS oNTT (52) gFUTT (52) gPTTT (52) 4? RTT (52) ,Patl (52) 


TamPER USEL FOR TakGeT uaTa 


WAMETRe= TAKGET NAME ARRAY, NORMAL USE IS 308906 
THPT©= TOTAL TARGET PUPULATIONe 

TRPR|@ KUNAL TaRGeT PUPULATIONe 

Thpuse URBAN TARGET PURULATIONe 

TRPUAS] UNbANIZEQ AREA TARGET POPULATIONe 
peeteeas 9 STATE Cove FROM 79 CENSUSe Ae 

THCoSge= Cousty Cove FROM To CENSUS» A 

[MUgCee UM 1ZEQ AREA CODE, Aw 

LREaC|= ECOMEMIC akEa CODE® AS 

LSiSeCe~ SMSh CODEs a¢ 

NUTHee NUMER OF CUnker tT TARGET IN A SEQUEsTIAL COUNT. 
TaCGbhAe= LATITUDE OF IanGET POPULATTOW CENTROLVe 


ween ynClassiFleu wees 1-39 yeyias7o PASE NO. 006 
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TREGLOee LUNGITUDE UF TaRGET cenTROrD, 4 
YTL== TARGET CENTROIC IN NORTH SOUTH COUHOINGTESe 
ATL" TARGET CENTROID IN EAST WEST COORUANATES© 2 
SigtRye= STaxvaky DEVIATION OF TaRyeT POPULATION ALONG BIG axkIS 
SIGTRLe= STO. DEVe Ur TARGET PUPULATIUN ALONG SMALL aAlSe 
ALTRe= ROTATION OF TakGeT MAJOR (LaRGe) AATS IN DEGREES 

CLOCKWISE FROm THE hORTHe 
NPLCS@= NUMBER UF PLACES IN TanGEeT AREA 
NMCU2*© NUMBER OF MINUK CIVIL DIVISTUNS IN TanGET AREA. 
NiTe~ TuTaAlL \UmbeEK OF CUUNTIES IN @ STATE 
PUTTe= TOTAL URBAN PCPLLATIUN IN A STaTEo 
PTTT=. TOTAL POPULATIUN IN A STATE 
PRTT#e TOTAL RURaL PurULATION IN aw STaTEe 
PaTT= TOTaL URRaNIZED amen POPULATION IN a STuTeEo 


ANAQANAANANNANAAAN 


COMMUNSPNDPR/WI D9 V9 SOME 9 SUweSHRST 9 SHR gy SGSHRP 6 SGSHR oe WMNDEK oD ALWNL 5 


' CAL Sale FLATMC (LUO) oFLURMO (LUG) PDEG iA ( 100) »SPOMO(1UU) eVSMO0(100) 9 
2 NUM 


WTNWUPR CONTAINS WIND HEL ATED PARAMETE+Se 


WIND@= CURRENT VaLUE UF MEAN WINDs MPHe 

Ves CURRENT VALUE OF SaMPLE WIND VELOCITY 

SGWP== win VECTOR STanuako UEVIATION aS FRACTION OF MEAN WIND 

SGwee VECTOR STANDARD CEVIATION OF wWINDe MPRe 

SHRSTee MEAN VaLUE OF WIND SHEAR MPH/KFT eo 

SHR=* CURRENT VALUE CF ®IND SHEAR #OR THIS SAMPLE 

SGSHRP oe STasvaRy DEVial ION OF WINy SHeaR aS a FRacTLON OF ME aN 

SGSpR\- STANDARD VEVIATION UF wIND SMEARS 

WMNOR|= MEAN WIND DIREC! LON _IN DEGREES CLOCKWISE FROM THE NOs 
leE. A VALUE OF 27% MEANS A WIND BLOWING FROM WEST TO EAST 

ALWNU@= VALUE OF wlio CIRECTION FORK THIS SaMPLEe 

CAL*= COSINE OF aL#NO 

SAL** SINE OF ALWNDe 

FLATMO== THESE ARRAYS REFER TO WIND MONITORING STATION VALUES 
USED TO GIVE WIND STATISTICS pata VARYING “ITH LOCATION. 
LATTIUDE Ck MONITORING STaTION 

FLONMOs= LUNGITUpE OF STaTION 

DEGMUS= ANGLE OF MEAN wiND AT STATION IN DEGREES CLOCKWISE 
FROM NORTes AS #[ Tm *MNOR 

SPOMGee BEAN WIND SPEED AT MONITORING STATION 

vVSmge* VECTOR WIND STAKUARD DEVIATION AS A FRACTION OF MEAN 
WIND SPEED. 

NUMQ@=* NUMBES OF MUNLICRING STATIUNSe 


aNaNggMNMANM ANA AANA AA ANAAANAAN oO 


& COMMON/ST aPR/UTCT eOmaXenv (51) 0E (S02) eXbV (51) eNO( ST) NBE(SOL) 
ps LNRL (36) enBOXA eNEOXL pNOUAE o SMLDUS 9 SD 9 S259 SDL 9 SDF 9 SSU9SS0S0950C y450F 
, DaNOML gNBAST (5) 452) gFOXST (100952) gCBXST (190952) pPMOFT (50) PROCS (SQ) : 
Z°SFTOSFISeSETCOSFTFs SCae SCAS*SCAC+SCaAFs TPUPLY (50°52) 
, *QOSEINO (100) 


STAPR USED TO CARRY STATISTICS ON MONTE CARLO TRIALSe 


NexXSTee NUMBER OF TRIALS IN SPECIFIED BUXES 5Y STATE 
UTOT*= CURRENT VaLUE VF TOTAL OOSE 

OMBASe CUHRENT VaLUE UF MAXIMUM DOSE> 

ov(Sh)e= YUSE LEVEL CUTUFFS FOR SPECIFIED JNTERVALS, 

oe (SUE; em OCUSE LEVEL CUTOFFS FUR EVEN INIERVALSe 
ALbv(Sh)|~ OCSE LEVEL CYTOFFS FOR LOGARITHMIC INTERVALS 


ananaAnA a 
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#088 GNCLASSIFIED #60 12/14/76 PAGE 
Nel(sller TRIAL COUNT FCR SPECIFIED INTERVALS 
NoE(S0,) 22 TRIAL COUNTS FOR EVEN INTERVALS, 
NOL (2%) ee TRIAL COUNTS FOR LOGARITRmMIC INTERVALS. 
NdOKAee NUMBER OF HUxcS FOR SPECIFIED INTERVALSe 
NopOALS= NUMBER Ue BUAES FOR LOGARITHMIC INTERVALSe 
NeOXE*= NUMBER OF dOacS FOR EVEN IvTERVALS, 
SMLDOS\=* CUTCFF <UR STATISTICS wyTROUT DOSES YNDER SMLOOS 
Su-> FOR TrrS Target Sum oF oToT 
SuS|“* SUM UF OTOT#®OTOT 
SUCe= sum oF OTOTeDIcTeUTOT 
SUF©" sum OF UTOTPUTOT*UTOT*OTOT 
SSp-" FOR DOSES OVER SMLOOS*» SUm oF oToT 
SSOS*= FORK UOSES IVER SML00S*e Sum oF DTOTenToT 
SSOCT= FOR UCSES GYEX SPLUOS® SUm oF LTUT*nTOT*DTOT 
SSOF*= FOR NOSES OVEN SMLDOS» SUM OF OTOT#nTOT#OTUTeUTOT 
NSMLT* NUMSER OF TRI4LS LESS THAN SMLOUS FOR THIS TARGETs 
NeXSTee USED FOR STaTe ENTRIES IN SPECIFIED BOXES 
FurSTe= USED FOR FRACTION FATALITIES FOR STATESe 
CokSTee USED FOR FRACTION CASUALTIES FUR STATES. 
PROF Tee PRUGAGILITY or & FaTALITY aT a GIVEN LOSE LEVELe 
PROCSe= PROBABILITY OF A CASUALTY aT A GIVEN DOSE LEVEL. 
SFT=** FOR EACH TRIAL 3UM OF NUMBER OF FATALITIES. 
SFTS*= SFT®SFT 
SFTC#. SFT PSF 1 eSFT 
SFTFo~ SFT®SFT®SFT*SF | 
SCAe= FOR EACH TRIAL Sum OF NUMBER oF CASUALTIES. 
SCAS*=SCAPSCA 
sCACe~ SCAesCAescd 
sCAFen SCAMSCAMSCARSCA 
TPOPLYe= TOTAL POPULATION AT SPECIFIED FATALITY LEVELS. 
DSEINY(409) == INDEX TO ORDERED LIST OF UUSES 


rome kelelemelelelekekeleteleteselekelelelele ekelsk elelelelelal) 
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ToPR CONTAINS INPUT OUTPUT mEDIUM DEFINITIONS, 


Cc 

c mMP]= STANUARC INPUT = CARD REAVERs 

c MQe=s STANDARD UUTPUT = PRINTER 

(- “Se= OUTPUT CF BCL PUNCRED CARUS. 

€ NAe= TARGET [ivPUT DaTae 

(» NC|#= weaPON CLUSTER [NFUT,. 

ra Noes OUTPUT OF TARGET TRIaL NUMBERS IN SPECIFIED BOXES BY mOSTP 

Cc NES*OUTPUT OF DATA al FERCENTILE LEVELS BY MLYTPe 

¢ NFe= OUTPUT CF INOIVIULAL DUSES BY mMPTP 

(si NG== DUMP TAPE BY ISGN AND JSGN 
COMMON/LAZY/TTasTTBeTICe!TOsTTESKTAsKIBROKTCOKTDONTESKTFONTGOKTA 

¢C LaZY USED FOK TEMPORARY VANTABLE TRANSMITTALe 


CPPetelEMPUORAKYOeee® 
¢ KTA USEU To TRANSMIT iLSFSw 


COMMON/LAZYA/TTAA(200) 9K TAA(200) 
Cc Ladra USED FOR TEMPORARY BZRRAY TRKANSMITIaLe 
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DoTA (BV(1) & reQ) g(3V(Z) = L060.) olov(3) F 2nved e(BV(4) = 4500)0 v 
1 (Fy (5) & 100U.) 9 (By (9) & ZO00e—) o(By(!) @ 40000) 9(8V(8)  10000.)» 

2 (8Y(9) = 3000%e) 

DaTa (YLom')) = 194) '% LUM! 2) 2 295) 9 (YL om(3) © gedo(YLum(a) # 

L  Tede€ YLOM(S) 3 Lge) o(YLUM(6) = 250) 

DATA (YLOTO1) = Led, (YLUL(2) @ 2.) 9(YLOI(9) = 3.) of YLDI(%) & Sy)5 
VIYLOIC 5S) = Lucero (YLUI(6) 2 200) e(YLOI(7) 2 300) 

OaTa TO (4) 9529S) ) ack 192M 2°2H 6924 SDH 6° 2H BON 92H] QP aN 
Deals Sols sz ytD eS Lo e2ql? 2aleeeetg 2qev eeel 22262003 22k ace 
25 2H26 227 CHS4 gp 2H29 SHI, p2HIL gp CHIZ 4 HID g CNIS y PSHID 4 SNH IO 92437, HID 
39 2H39 4 2MGy 4g 2H4)] ,2H424 244, 2H4S 9 2M46y 2447, ANB, 2H494 259 2HS1 9 2NS3y 
“2H5692HSS92nd6) 

DaTa SCIStNM! J) 652] 95)) =2rAL 9 DHAK® QHAZ#2HARP aHCA® DNCOSSNCT 9 OMDEs an 
VOC e2HFL e2HGas2nrl oQHID een be 2HINs2HI As 2H<S#2HKY oCHL As 2HME » 2HAD 9 CHM 
ZACH To CHMNe CHMS 9CHMU OCRMT 9CHND 9 CHNVOTHNG 9S SHND9CHINM 9 SHAY P2HNC 9 & RNY 
J oP HOM se 2HOK 92NUR eCHPA SCHL eSHSC HCHSD eH TNGCHI Kg CHUT SCMVT OCH VA CHW AD 
42 WV eCnw] eCHWY) ‘ 


CURRENTLY NC IS FROM CaRnus 
een heeeee 36. 0/6400 COMPATadILITY CHANGE ##*etPtnnteoue 
> 2400 CAkDS 
? Mp = sLINPUT 
= 6LOUTPUT 
2 SLPUNCH 
= SUTAPEA | 
Nc = SLINPUT 
2 
2 


anN0 


SLTAPEC 
SLi apes 
NG # SLTAPED 
3609 Cahus 


aaaoaoanaan 
z 
> 
" 
wu 
co 


F ISITNO & 0 

* NUTR 2 

t lostco 2 ?x 
z 


4 C HOP H OOH 760U/E4Cy COMPATAHILITY CHANGE ##@eePeooeerne 

; ‘ CALL Sse TCH ("+ 6n) i oe 
IF (SENS WITkR 2) By 
1 195GN eB, 1) GO TO 8 ole Lrbd om wists 

ey Go TO 9 

CONTINUE 

RESTART FROM DUKP TaPEe REPOSITION PREVIUUS OUTPUT TaPeS BY END 

OF FILE MARKSe aSSUme PHINT OUTPUT FROM gEFURF SAVED ELSEWHERE. 

MEKO(MP 935) JRESTe JRESTN® URESTA® JHEST)) op URESTE» JRESTF 

, 35 ForAT(/ 96110) 

Pty InvUuT @ = 4 7? 
Cale [ULmPlINUYTsyTUSTCHeISILU) l Rye le 

WRATE (veel) 


token: 


:, ‘ ? #9°* UnCLassIFIEU *°** 12414776 PAVE NO. anc 
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“PT oom 


lo 


32 


@e8e UNCLASSIFIED eee 12/14/76 
CablL INVAL 
Cakl PanOuT 
Go TO 10 
CONT INVE 


Caul INVAL 4 

CaLL PakUUT 

Ip (IFRSK Ds GO TO 10u 
IF(ICLUST eNEe*) GO To TY 
CALL INIT eee ee Ra a3» et ee ee 
Catl CLSIN 

CONTINUE 

ColLL TSTIN 


PAGE NO, 00+ 


7 


o fox 
SaPeenerenesseensetHey,jys64u) CUMPATIBILITY CHANGEWSbenenes pee 


CALL SSwich(2enSGN) 

IF (KSGN e€06}) GO TO 32 
Te (SenSé€ Swy'cH 3) 31,32 
Go TO 32 

CONTINUE 

IT 2 grST CTY 3 

ENCOVE (14454% [LAs TT eins [cur IRCOCO 
FORMAT (A9,AZ 903) 

TpAd(3) = 

Cole REMARK (ILA) 
ConTINUE 

IF (ILAST eNFey) GO TO 2) 


C #eeneeene2360U/6400 CompATuadILITY CHANGE ##¥oeeeeneaton 


c 


25 


24 


17 
1g 


ly 


li 


21 


IF (SENSE Sw1TCH 4) 25524 a ae a 
CALL SseTCH(leIsGn) 

IE ([SGn s€ue 1) GO TO 25 

69 24 

CONTINUE 

InvuT = 1 

Call Tgume (rout TOsTcus{STLU) 


cont enue 

NUTH = WUTR * J 

let IRSI¢o eEN1CSTCD ) LC TO 12 
fasTcd = yRsTCe 

IsInwo = [STsu_¢ 

Le (gSTwUeg ToS?) 60 To 2” 

vO JF 9 ‘ a 


JJ # J 

IFVIRSTCO e€Ue [STC(y) ) GY TO la 
CONT pug 
IsTLu # ] 
60 TO 19 
CONTINUE 
IStLY = yy 
CONTINUE SO arene tk 

ICARRY(ISTNO) = ISTLU 

JSICO # ISTC(ISTLU) 

JSINM 3 IP]NM(ISTLY) 

WRITE (MG **) 

Form T(lyl 

WRITE (MU9l4) «TSTNM(ISTLU De TSTC(LSTLY ) 
FORMAT(S////79 2UK9 *RESULTS FUR THE STATE OF %» Aas 
1 @ "LT COVE @, A2yysss) 

ISwING * } 
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Continue y 
NTTCISTWO) = ATTCLSTWO) © 1 
PUTT(ISINO) 3 PUTT(ySTc) * TRPU 
PTIT(rStno) = RITT(ySTNQ) © TRPT 
PRIT(ISTNO) = REIT STO) * TRPR = 
PAaTT(TSTNO) @ BalT(ySTwg) * TRPUA Lt 7p) bebof- 
Cate PREPAK 
Cake MONTE : 


Call WRIONE ~ 

IF (MLVTP eNEel) GO TO ly 

WRITE (NEet5) THCGLA + IREGLG POSERLA PUSEPLE eDSEPL Ce IRSTCO*sINCOCO 
Farmar (F1 00% s2neF 106% 92x 9cF Let yoK 9h wlAgA@) aa : 
CONE FhuE 

6o TO 10o 


CONTINUE Lid towmey 
Call weTLST aw : + Lex fob 
Ip’ “pSTP eNEel) GO TO 22 

CNDFILE NO a e: : 
KEWING WU 

Cowl [Nue ; 

IF (MLYTP eNeol) GO TU 20 
ENOFILE NE 

REWIND AE 

CONT [NUE 

IFcmmPTP NE.) GO TO 27 
CNLFILE NF 
REWIND NF 
CONTINUE 
CONTINUE 
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COMMYUNSRUNSW/ICTYCosIHLivl eACLUST ® ISINGW9L ABEL (2.92) 9ISPHSaeILGwSne 
HLEVa S40: MOST orUSEVs [nSasa LLVEW + DOSELY (0) a PEROSmMsBROLY (3) ¥ICAT Se 
e MUSTER MLV TB yma le, TCLS ag UTES pURESTIV, JRESTA, REST URESTE,URESTF, 
2 TFRSK el UMpS eS 4MP os [STAT LWNOSTs ISHHSOWS [HLVSWoMUCKs ISEELSSEEDS 
+ MSUSa CSEED 9 1F CAS, PEL Vy PFLVU(7) »PFLVR(7) 9FOSEMgFUSESG 9COSEMy 
> COSESGeMOCAL SICLYLDyICLYLgFRPFU(7) ,FREFRI7) 
aPTESTcCTs JSTIN( su) 9{CTIV(1 50) 91SeaSeNSTIneNCTIN 
COMMUN/RUNPR/ AX SOMPeNHEISONSNPCTo ILASTs [OTNOeISILOsUSTCU Ss JSTNMy 
1 aT (SL) gISTNm (21) op ICAnWY (10U) sUSEPLTs IUSEPT eAPLT 9 YRLT 
2 9D2EPLAgDSEPLG, DSEPLC, ISAING, JSWING, FIFATUFRCASU,FRF ATR, FRCASA 
COMMUN/CLSPR/ YLUC(5¢ 9) *FISSC(5yg) *XNC(Syy) *¥WC (SQ) *SIGAC (S0Q) * 
Y S1GYC (SAG) eNCLS9SARY (50045) sYLDT (7) 9YLDM (6) pQaRYL (7919) 
Chany (7440) 
ComMUN/TARPR/ NAMETRI LU) oT APTS TRPUsTRORS TRPUAs{ RSTCOPTRCUCO?® 
VERY AC g TRE AC, LSMSAC yNYTR,TRCGLAgTROGLOeYIL ATL, SIGT RH eSTGTRL, 
2ZALTReNPLOS#NMCLSONTT (52) 9FUTT (52) 9PTTT (Sa) sPRTT (52) oPaTT ($5) 
COMMUN/STAPR/U ICT sOmAkerv (91) DE (302) oXL4V 671) on@ (51) eye (501) 5 
DBL (56) NaC Kd FKL RIAL, SMLOYS, SD, SUS, 5004 SF 4950, 55S, Suc, SSuF 
ZYNSMLINDAST (59°52) 9FSAST (1 09 °SE) 9CBOXST (1 990952) PPRUFT (65y) PROCS (5Q) 


uu 
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5 eee UNCLASSIFIED *eee 12/14/76 
apSET SEIS SeTC,SETF, Sca, ScaS,Scac, Scar, /POPLY (50,52) 
a OSElNu li gud 
COMMUN wWSEGS YIELNoF ISN 9h UR eZ 9SHLo KOs YCWSATRAg UARRY (19? 
COMMGN/LAZY/TTag ITB, TTC, TTD, TTEsKTA,KTBeKICIRTUgKTEQKTF y NIG KTH 
COMMON/LAZYA/TTAA(200) snl aal2on) 


NBHOAA 3 9 
NBOAL 2 37 
NBOAE # nosev * F 
Apavily) = Oo 
XLG_2 Te 
vO 9 y 2 2enqgOAL 
ALOV(g) & 1L0e#*#ALG 
ALO 2 ALG * Coe 
3 CONTINUE 
___KNuSEV ® wOSEY ea 
DELO = UMOST/ANUSEV 
OO Ue <= 
09 5 9 a 1 yNoOxE 
o& (uy) = OD aL 
OD = OV + VDELD 
5 ConTINue pete Be : = 
~ Bv(nodaa « 1) 2999999999, 
ALEVINOOXL ot) eg 999999999, , “ 
“Be(wooxe « '))  ——  « $99999999, fag 
00 ll I= 1,Sv 


_.__MeAsT hed 2» oO 

TPUPLV(I"y? = Oe 

120 cowtpnue 

11 CONT Tivue 
vO 16 I = leluo 
do 1? ys 1,3¢ 
FAAST (I 9N) 2 Ue 
CHaST (Lod) = Je 

17 continue 

16 CONTINUE 


DO i4 J = 1952 


yTTly) =F ¢ 

PUTT) = 0. 

Printy! = Ge : es 2 

PRIT(y) = Ye 

Pait(y) = %. eee : : ee 
14 CONTINUE % 


IF (ISEEL .NEeu) GO TO 32 

C Paeetaeeee390U 76400 COMPATABILITY CHANGE #e*eeeeeonnnoe 
CALL TIME (CLTIM) 

_CLitm = ABS(CLTIM ) 

CALL RANSET(CLTIM) 

C CLTIM = TIMEFCOLMMY) | 

c CLIIM = ABS(CLTIM ) 

c CALL RANFSETI(CLI IM) 
6o To 33 

32 CONTINUE = 

Cc Heenteteee 60 g/5au0 COMPATaRILITY CHANGE ##P eh Peonences 
CALL HANSET (SEES? 

5 CALL Rank SET (SEEL) 

3 Continue 
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Frsn = le 
— 
Vo 38 I s 147 

yYrEun 2 YLOTG]) 

vo 39 vy = lglg ? { 
QARYL (19d) = GARRY (IY) 

CONTINUE ; 

RETURN 


Hod = Ye { 
CALL aFALLY 

ConTINuE 

ENu 


SUOROUTINE INVAL 


InPUTS PARAMETRIC VaoklaslES INCLUUING wInD AND CONTRUL VALUES 


COMMUN SRUNSW/ICTYCBg IHL Fe LCLUST s ISINGWeL AGEL (2092) o1SPwSa,lLGusws 
VIEYASW 9 L MOST eNLSEVeTHS¥Swe TL VS 9(yOSELY (5) # LPROSW*PROLV (3) sTCaTSw 
2 MUSTP oML_VIPeMMr TR 9 TCLS 9 GHEST 9 URESTive JRESTAs JRESTO sJRESTE sJRESTF® 
> TFRSK,IDMAS,NSam®, pST al TWrpSt, TSHRSW, |WL/Sw MUCK, ISEED, SEED, 
4 MUSH sCOFEN oe IFSCAS iNPFLY yPFLVU(7) sPFLVR(7) 9FASEMSFOSESG9CDSEMs 
3 CUSESGPMOCAL PI CLYLDSICLYLUsFRPFUI!) sERPFR IT) 
mo pus iets PST tet 2) oC pet 106) « SSE Coens Tingtiol th 

COMMUN KUNPR, XNSaNP NAPIS NSH CT, LAST, p STNG, FSTLO, UST CU, JS TNM, 

i ISTCL51) 9ISTNM(S)) PI CARRY (109) *DSEPLT*IDSEPT*APLT*YPLT 

7s DSEPLAPUSEPLD eUSEPLC® LSM INGs JSWINGoFREATUSFRCASUSFRE ATROFRCASR 
COMMUN /HNUPR/MTAU 0 V 9 SGP SOW SSHARS | pg SHH ¢SGSMRP e SGSHR »WMNUR 9 ALWIVD 

1 CHL ISALS FLATHO (100) eFLUNKMO (100) 90EG:19 (100) SPDM0 (100) »VSH0(1U0)» 
> NUE 

COMMON, STAPR,OTST, Omak, 4V (51) GE (502) yXLBV (51) 9NB(51) gNdE(SU1) 
LNRE (55) 9NGOXA oNHOAL 4 NBUAE »SMLDUS 9 SD 9 5US9S0C9SDF #SS095SNS9SS0CeaSvF 
2enSmLaNBAST (S972) 9 SXST 1100992) sCBxST ily Bog? PROF T (Sn) sPROCS (30) 
rgSFT SETS SeTCSSETE, Sca, 2CaS,5Cac, Scar, POP, ¥ (59,52) 

w OSET Nu CL yu) 

COMMUNS TORR MP eMQamS orn aot COND INE INES WGHWHINT oN INK OIL 9 VM 
COMmMUN/LAZY/TIAsTIBs II Col TU eTTE sn I AK TB9KTICORTUONTESKTF ORIGIRTH 
CoMMUN/LAZYA/TT A (ENG) on TAA (COU) 


KEAU (ME 96) (LAGEL (Tol) ots 1920) 
Reav Sapte) (Laser lr9a) OD fs 1929! 
FORMaT (20946) 

REAL (MPO)  LFRSKRe LOMAS 
FORMAT ( ye2tlo) 


REAU(MP S21) ICTYCBsrelut 
FORMAT (/ 92110) . - 
REAV(MP O21) LCLUSTeISIvce 
REaAv(MP 921) ICLYLD»ICLYL® 


REAU (HP s6,) ILSTCT 
Formati/eziC) 
IF SILSTCT e&Ge0) GO TU “ec 


KE AU STATES 10 USE FIRST®s 3Tor ON SPoTHEs COUrTIeS Sloe 
UN SPe iF ILSTCT IS UNE UNLY ONE SP 


aa FY” ~ 
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NO. 


10 


004 
Jo 


Gu 


eal ea a Ses eh le abs a 


44 


43 


46 


ar <a 


ae 


26 


Coeeen}leM 


12 


16 


23 


35 
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Con! LHe F 
JJ = Ju #1 
be ISTIN(Uy) 

Format (A2) 

IF ISTIN(JU) ehEo 2HSP ) 6O TU 4% 
NSTIN 3 JJ = ri 
IFCILSTCT e&u5 1) Go Ty 2 


CdnT phuE 
WJ * JJ 1 

REAU( MP%45) Foumnes 

FORMAT (a5) 

IF ( ICTIN(Ju) enEe SSP ) gv To %6 

NCTIN 2 JJ = — 

CONTINUE 


REAL (MP 926) LSPwSwsITLGaSwy lEVwSws IMSwsw eILSFSw 

FonyAt 795110) : 
OR aK Yeeeee 

NTA * [LSFSw ; 

Reav(MPele) ICaTSw 

READ (P94) OMUST® NOSE¥s SMLOUS 

FormmAT(/9FlOeus I10, Flier ) 

Re av (NP 927) ILYSwy (DOSELV (I) gle 1,5) 

Format (4°11u°SF1000) 

REAL (P9238) TPROSWs (PROLV (J) ope 1,3) 

FOWMAT (79120 02F 10,0) 20) 

READ (up 934) BOSE Maer Rne Te 

FORMAT 93 

~ Ke av (i B22) MEST, REST, JFESTA,JRESTO, JRESTE, JRESTF 

FORMAT ( "oly y? = 


REAL (MP 921) NSAMP 9 ISTRAT 

“An oAmp 2 yS4up 

{RPTS = NSAmP/190 

“EAv (MP ya) 14hOST wry, Sor, weNOR, TSEaS 
FoRMaT (4 e110%3F 106 arti! 


READ (MP9 14) ISHRSW9SHRST + SOSHRE 
FORMAT( /91109 7FlU,u) i 
Gg = SotPew Lat 

SGSHR = SHRST#S ;SHKP 
REAU (P91) LaLySw 
FoRMAT (79710) 
Reau(MPs le) ICLSA . 
REAL (PY 2 Joath oe 
REAL (MP 929) ITSEEDsSEED ema SWeCSEEU 
FORMAT (So TlLOoF li eGoplU ob dieD) 
meauiwes2i) LFS CAS yNPFLY 
re aime So (PRLVUCT) isi o3) 
READ inpec*) (FROFUCT) ojate!) 
REAU (HP 726) (PELVR IT) etsie!) 
REAL (MPe24) (FREFR(T) 9 Lely?) 
FORMAT (/ 585 259) 

REAU (mp ed FUSEMsFOSESG sLUSEMsCOSESG 
FormAtT (79°F 10.0) 


IF (LatoST eNEol ) Go To 7s Read frit Ward Doo, 
NUMO = y 
CO F BuBUe2/52406 
1-47 
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To CONT IVE } Z jis 
REAL (MP 97]) LaTeLONelTMvelwSe [wSDeISUDsTSUS#LSUSD 9 [SPJ [SPSeTSeSne 
! [FUsIFSeTrsu 
7) FORMAT ( [> 92K [30 SKoLselAv [ol Xo[solxXopIolXel IelAvlIelkep elke 
L Lae tkol3,1Xgl3,lAgI3e lAvl3) 
Ir ‘LaT e€@.0’ GO To 75 
NUMO = NUMO * 1 
FLATMO(NYMO) = LAT 
FLONMO(NUMO) = LON 
IFCISEAS .NEel) 60 TU 31 
Zo = IU 
2s 7 [as 
ésu = [ws 
60 TU be L 
gl CONTINVE : 
Ip ({SEaS eNEe2) GO TU 42 
20 = [SPD 
2s = ySPs 
ésu = [SpSo 
co TO 96 
82 CONTINUE > 
fe (LseaS eNEe3) GO TO 43 
Zp = [Suv 
Zs = ysls : 
Sie" Susp 
GO To sé 
33 CONTINUE eee, 
Te (ISEaS eNEeg) GO TO 3,4 
SéSES TES 
Zn = IFi 
£50 = {FSp 
GO TO «6 
86 CowTINue : = aan = 
én = Iau * [SPp * ISuUD + IFO 
zy = 9.65820 
é 
Zs 


1wS 4 [SPS + [SUS , yrS 


ge25*Zs oetosten tat 
ésv = f*so * [S*Sy ¢ [SUR * JFSpH 
Zsvp = %e?5*Z5U Es 
86 Continue 
VEGMO(NUMO) = ZPD 
SPumU(NUMO) = ZS*CO 


vgmo (NUMO) = ZSu*CO | we mee = 
& To u 5 7 Say 
| ME id a eee Te ‘lati cil ae ee 

*& RETURN 


’ * Archer bated 
- * . = eee — 
: SUBROUTINE JOUMP (INQUTs [uSTCOsISTLU) Louterw pyobd 
; c InouT = 1 wRITE ON Dump TAPE —— ~ 
B Cc INOUT = 2 KE@U FROM UUMP TAPE 
i x COMMON/HKUNSw/ [ASA (274) 
; COMMUN/RUNPRZ Lanes (223) 
- COMMUN/CLSPR/ LARC (5927) 
: : ComMmMONs TARPR/ TA4U0 (299) 
4 COMMUNS ANDPR/1p*€ (513) 
~ COMMON/STRPR/ TARE 1729) 
sf COMMUNI OP RS Mr eX Qe ySe wn ei CON ONE INE 9<Ge VR ONT gp NSONK ONL 9 NM 
: CoMmUN/LSZYZ Lac (19) 
‘ Commer sEaZras [aan(4 9%) 
r ‘ T-48 
j { woes UXCHASSIFIEU aes ; teyies76 Ppo— 0. on 
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f : SNL: stern eee 
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32 


33 
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1> 


Hate YNCLISSIFIED #44 
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TF(INOUT .EGe 2) GO TO év 


wRITE(NG) ToSTceelSTLu 


24) 


ARI TENG V(TARA(T) «© IT = Ls 
WPITE(NG =) (Latd(IT) » [ @ ly 223) 
WRITE (NG V(LTARC(I) » If 8 ye 5927) 
“aRITE(NG =) CiARD(T) » [ 2 1, 285) 
WALTE(NG =) (ZARECT) 9 | = de 2232) 
WITTE (NG pptare ely » I 2 le 17029) 
WAITE (NG ? ¢famGtt) 9 tf # pe a3) 
#ALTTE(NG VOLaRR(L) » fe le bu) 
_ENOFILE NG 
REWIND RG 
REwLND Na RR a Se 
MDSTP 2 tana tog) 
MUVTP = rakA(6J) Bn ee. 
MMPI[P 2 y[akA(O4) 
IF (musTP eNée 4) GO fo 34 
ENUFILE NO 
HEALD NO - 
CONTINUE 
IF (MLVTe .NEo 1) GU TO 3c | “s - 
ENUFILE NE 
KEwING NE —- = 
CONTINUE 
_Ip(MMPTP «NEe 1) GOTO 33 s 
ENUFILE NF 
REWIND NF Bee eae eh seen ee re ae 
CONTINUE 
Re TURN te Oh EE ea ee can 
CONTINUE ND LS te A ee 
KEewlNo AG 
ReE@INO Ng : = 
READING) TOsStcosIStTLu 
QEAU (WG VC TAHA(T) 9 [ & by O74) 
REAL (NG YCLASSOT) 9 [ & le 223) 
Pead(.G yp (IA"C( 1) 4 I & ly S427) 
READ (AY VCleaso(l) © [ = 19 eb9) 
READING V(laA~EeCLT) » JT = Le 533) 
REAU (NG VCTASF (1) 9 Lm le dled) 
SEAO (NG ey e I 2 ly 13) 
RE au (NG (Lann(l) » T= 19% 60 
JREST = Takalos) 


+ 
mr 


IF (UREST eEue ©) Go To 

JTM & TAOS( REST) 

Ip (ute e€ue*) Go to 5! 

JRCSTN = [ARA(67) 

IT™ 2 JRESTN 

wo To 3¢ 

CONTINUE 

ITM & [akpi2u) 

ConTINUE 

NUTRA @ [TM ¢ | 

MRITE (MU dD) UTA 

FORMAT (Lal e////7 930 K9PHESTART FROM TARGET NUe M91 59////) 

MUTRT o ogrTm 

00 22 J “oo 
A Ae) 

HEAL (;,Agte) I-49 
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FoRmal (14) 

CONTINUE 

IF (UREST .GTe ©) GO TO as 
MOSTP = IAKA(82) 

MLVTP a pARnA(o3) 

MMPTP @ [AKA(O%) 

IF( UREST enEs =2) GO To 49 
JRESTA = yhRA( EA) 

JRESTO = [ARA(69) 

JRESTE 2 [ARA(T") 

JRESTF = yARA(TI) 

1F (mMUSTP enNEo ') GO Tu FE 
Vo *7 go = legrestu 
READ (NU 9 1S) 

Confinue 

CONTINUE 

Le (MLVTP eee 1? GO TO as 
vo %9 gy a le yRESTE ; 
neu (NE 912) 
CONTINUE 

ConTINue 

Ip ( MMETP eNEe}) GO TO 43 

NS4mMP = pans (}) 

KTM 3 \SAOmP/10 

KKM = KTMeld 

TRE (KKTM eNEe NSaMP) RTm 2 RTM & 1 
Keim = sKESTE@(K Tue) 

Do 5% jy = lexxtm 
REAL (NF S12?) 

GORETNUGSe= 5 pea, ee 
CONTINUE 
CONTINUE 
IF (ALVTP eNEe 1) GO TO 42 
Continue 

ReaD {NE 912) 


C satatataee 3097640) COMpPATASILITY CHANGE #a%ee*tenvaves 


Irk = EYE (Ne) 

Le SIFL eNee py? GO TO 24 
IF (ECF 9vE) 24905 

Cowrinue 

GO TU 23 

CONT [hue 

gaCKSPacE NE 

CONTINUE 

If (muSTP .NEe 1) GO TO 4} 
CONTINUE 

RE au (uel 2) 


| C #8908 9808 3650/6400 COMPATAGILITY CHANGE ###at*eeotanon 


IFL 2 EUF (NO) _ x 
IF(IFL eNEe °) Go TO &6 
LF (EOF yNU) 26567 

CowvTINUE 

Go To 28 

CONTINUE 

BACKSPACE NO 

CONTINUE 

IF (mMPTP .NEe 1) GU 10 43 
CONTINUE 

REAL CNE 912) 


C Bee ate mews 3655/64) COMPATASILITY CHANGE PO %etPeneuerne 


Pa 
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F; 62 
3 26 
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wy 
Fy 
Cc 
% 27 
* 26 
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cd 
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IF(IFL eNEe gy) GO TU 34 
ACCPPORELITS. 

ConTINue 
GO TO ag 
CONTINUE 
BaCKSPaCE NF : 
CONT [NUE 

Re TURN aig a -— a a oo 

ENO _ 


SUBROUTINE PaRoUT 


OIMENSIUN ITELL(2) Se = 

UIMENSION vSEA(S) ‘ me 

UTMENSTON LWEP (130) sCSPTX(5Y) sCSPTY (20) ySSPT4 (5%) #SSPTL (20) 
1SALS (50) CALS (97) gIpnT (20) 9ST (4) 

COMMON /RYNSW/ICTYCB, HLS! LCLUST, IST Nsw LABEL (2092) 9 LSPaSW, ILGMSm, 


 ) LEVWSWeUMOSToNDSEVs [nS4540 LLVSH9()USELY (5) 9 LPEROSWSPROLV( 3) *ICATSHe 


2 MUSTPeML VTP o4MP TPs [CLSASUREST 9IRESTING JRESTAS JRE STOSIRESTE Sp JRESTF 9 
2 TFRSK,IDMASyNSamPy STRAT, LWNOST, 1SHRSwWy PHL VSw MICK, ISEED, SEED, 

+ MODSWeCOEED SIF RCAS »NPFLY eOPFLVU (7) sPFLVR(7) 9FOSEMsFDSESGSCOSEMs 

3 CUSESGMOCALSICLYLDSICLYLWsFREFU(T) oFRRFKI7) 
Ss pbsters Toyitt ers per ier ears SEAS oNSTININETIN 

COmmON ,RUNPR, xSSam yNRPTS,NSm cT,ILaot,yz>° O,ISTLO, UST CU, STAM, 

1 ISTC(S)) 91ST (51) * LCamRY (100) *OSEPLT* IUSEPT*APLT*YPLT 

PPSELA USE PLO +USEPLE iam NG oJ Ger REATU SF RCASUSFRE ATR OFRCASH 
COMMUN /WNDFRWINU,V2Gar SGM, ANST Sri Sg SHRP OSGSHR WMNOM AL WNL, 
CAL SSAL®s FLAIMC (100) 9FLYUNMO (100) 9DEG"0 (190) »SPOM0(100) »VSMO(1LoQu)»® 

sUMQ ° 

GENAONT TOPAZ” MPTMOPNSTNAINC OND SNEUNED SO) NNINTI NGS NRGNL AM 
COMMUN/LAZY/ITAsTTB os TTCeTTOoTTO MK IAgninoniCeKTOSNTESKTE ORI GSKTA 
ComMMON/LAZYA/TT 4A (200) 9 [AA (200) 


Data (ITELL(]) 3s 6FNO WoT 3 )eo(TTELL (2) = oh vo ) 


DATA (JSEaA(}) S6HWINTER 1° (JSEA(2) = 5HSPRING Y*( JSFal3) = 
1 FRSUMMER) 9 ( YSFA(4) = 6m FALL )9(gSEA09) 2 FHANWUAL ) 


wRITE (M977) 


C Peer Pnteetson)/64.¢ ComPATAH ALITY CHANGE set oeteenrncoe 


c 


Iz 3 = 

£7680 

CaLL TIME(CLTI™) 
CLTIM = aBS(CLTIM ) 
CALL RANWSET (CLT) 
Tem a RONF (12U) Peart tna. c8 Rian Sane 
UNCV # ©9, « luleTey 

TEM 28 RANE (T2L2 of SAR: 
NSPOT = 4%, « 4°, @TEueT Em 

lu = 9 

00 $4 7 = lywspot 

TEM = KANF(IZL) 

CChTA 2 &, « 1S ywte,, 

Tem a RaNe (Tél) 

CCPTY = 5. * woe TEM 

Tem = wane (72) 
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taee uiclLasslFleu Ooms. AIA a PAGe NO, 
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ee 
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[ col ff Racked healine 


OMe 


#898 (INCLASSIFIED a00% 
ScPTA 2 2, 6 Laveltn 
TEM = KANE (IZL) 
SCPTY = SCPTA®( 03 6 Y.7*TEM) 
IF ({eEGet) Gu ts 13 : 
vo yztlely 
IF (CCPTA .GieCSPTA(Y))IGE_TU0 12 
Ir¢ CCPIX * ScpTA + Leet! 
Go TQ 15 


l2 CONTINUE 


Rael ah a cs SA ere 
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Jo 


ecSpPlAcs) = SSeTs(J)) Go TO 11 


Ie‘ COPIA = SCPTA = Je euTecSPTa(y) * SSPTxty)) vO TU {LL 


1> ConTInue 


teiccPty oT. cSPTY¥(4)) of TO 16 


Ie’ ccply + scely © ,e euTe CSPTY(y) = SSPTL() ) GO To 14 


vo TO 
ConTINUe 
Ie (ccPTY = 
ll ConT [NUE 
13 Continue 
ES Se Fs oy 
CsPfatju) = 
CsPTY(iuy = 
= 


16 
SCPIY = Le eb Tecsetyi(y) 


CCPTA 
CCrry 
SCRIA 
seri 


i | sselolry) 
j SSPTL(IN) = 
a Tem = ReneS Zt.) 
' ALPH a J.14lSymnse rem 
S4ES(py= Sqn larry) 
CaLS( ry) = COS (aL PH) 
4 14 CONTINUE 
NSPOT 2 Ty 
; Tem @ wane (T2L) 
ACN 2 14%, + O.eTE4 
ACNS @ ACN*ACK 
vq 21 «x s 1,64 ee LS PA =) 
AK 2 & 
IFL_ = | 
Do 22 [| & lewsrol 
Ip (ASSICOPTY(L) SAK) eOTe SoPTBIL)) G0 
IFL = IFL + 1 
[pw (TFL) = i 
CowTINue 
ud 26 vy = leldy 
‘ coe ee 
SUM 3 <6 
. {FS eE0 
4 a) 
M = [PNTCy) 
IF (asS(COPTX(4) *XJ) e¢GTe SSPTH(m) ) 
Ux = CSPTXim) © AJ 
, OY = CSPTY(mM) © AK 
q UXP = VAPCALS(m) © DY*SALS (14) 
vyP TYRPSALS(M) © DYSCELS Cm) 
LJ Two SSPTB (mI *SSPTS(4) 1600) 
Tee SSPTL (4) @SSPT) (™) * UeI01 
j ‘ ALD = UAPPUKR/THS * UYRPPUYP/TML 
s 3 ALS = le = aus = 
IF (ALS elLEe Ye) GO TU ¢7 
SUM 3 SUm ¢ ALS 
CONT Ihust 
Te (SUr eGTegel) GO TU 2s 
LINWEP( YQ) = ‘al 
6a Ty 29 


To 22 
22 


a) 60 Th es 
olPL 


ou To 27 


27 
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CONTINUE 
Tem @ nw NE (TZL) 
VaL 2 1Y,esum © &.@( TEM = e5) 
IF (VAL eGTele) uo To 31 
CoNnTINUE 
LINEP (J) = [A 
Go To 206 
CONTINUE 
IF (VAL eGTeje) GU TO 32 
Breer ts! so lye 
GO To <6 
CONTINUE 
TE (VOL 2GTe5e) GU TO 33 
LITWEP(y) = tHe 
60 To 26 
ConT i Nue 
IF (val eGTeze) GO TO 34 
GENER ty: = tHu 
vo fo 66 
ConTINue 
IF (Val sGhsge: av Tyo 35 
LENEr C4) =z +H 
60 Tu ¢& 
CONTINUE 
LUVER (SU) = Lln® 
ConTINue 
It 2 Uncv - 1 ; 
IF (meL Tel Tm) gy To 40 
ITM = uNCv + aoe : 
Ig (KeGee ITM) G9 TO 43 
Yy = uvcv ¢ “! ok 
vo 41 ; s 30,107 = 
Ax = p20” 
ALS 2 KAPXASACINS © YYPYY/ 306 
[LF (ALS eGeete) Go Ty * 
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Te (Mucal .NE~ ay 69 TO yy 

WRITE (MU%Q95) 

FormaT(lnts use wSeG HICLOGICAL 005-4) 

oa TO 3% 

CONTINUE 
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NAME: AGZSEL 
SYNOPSIS: Detailed Urban Tract Damage Assessment 
TYPE: Semi-Production 


USE: Urban Damage Assessment Under a Variety of Conditions. 
Prime Data Source for Computer. 


BACKGROUND: 


DESCRIPTION: 


INPUT: 


Parameter Cards in Source Program. 
Tract Locations. 


PUES 
aus Separate set of Printouts, Printout Maps, etc. 
300 Runs 
IDA Run 77 
STORAGE: 
IDA Card Deck #84 
DOCUMENTATION: IDA Paper P-752, "A Sensitivity Analysis of 
Urban Blast Fatality Calculations," 
Leo A. Schmidt, Jan. 1971. 
LANGUAGE/SYSTEM: FTN/1604 Operating System 


COMMENTS: 1604 Implementation Only. Contains Many 1604 Unique 
Instructions. 


Developed from IDA Program DGZSEL. Variations 
added to Study Varying Blast Shelter Options 
and Compare MONTE CARLO with expected Damage 
Results. 

Performs Weapon Optimization and Detailed Damage 


Assessment. Allows for Several Assessment Func- 
tions Reflecting Various Weapons. 


COMPUTER PROGRAM DESCRIPTION 
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COMPUTER PROGRAM DESCRIPTION 


NAME: LANCET 

SYNOPSIS: Convert ADAGIO Output to ANCET Input 

TYPE: PRODUCTION 

USE: To Use ANCET Damage Assessment Calculations on Evacuated 


Population Data Base 
BACKGROUND: Developed as an auxiliary program for MEVUNS system 
DESCRIPTION: Converts ADAGIO output data to format needed by 
ANCET 
INPUT: ADAGIO output tape (RSAC ADAGIO) 
OUTPUT: ANCET input tape 


STORAGE: IDA Card Deck 109 


DOCUMENTATION: IDA Study S-394, "Methodology for Evaluating the 
Vulnerability of National Systems," Vol. I, Part I, 
Description of Methodology. 


LANGUAGE/SYSTEM: Run (FORTRAN)/6400 SCOPE 


COMMENTS : 


i COMPUTER PROGRAM DESCRIPTION 

is NAME: AIP/ANCET | 
| SYNOPSIS: Nationwide Damage Assessment Calculation | 
TYPE: PRODUCTION 

USE: Nationwide Damage Assessment for Blast and Fallout 

Given on Attack and Fallout Shelter Assumptions 


BACKGROUND: Originally developed at Research Triangle Institute 
and sent to NCDCF. The version was modified at IDA 
to increase allowable attack size from 1000 to 3600 
weapons. It was used in IDA MEVUNS Study and sent to DCPACC. 
DESCRIPTION: Analytic calculation of blast damage to Gaussian distributed 
population nodes. WSEG1O fallout calculations. 


INPUT: Population Data 
Attack data 
Shelter assumptions 


* OUTPUT: See IDA Card Deck #175 
IDA Run 81, 82, 101, 115 


Parte 


STORAGE: IDA Card Deck #106 


: DOCUMENTATION: "An Analytical Technique for Urban Casualty Estima- 
tion from Multiple Nuclear Weapons," Jeffrey J. 


Hunter, Operations Research, 15, 1967, pp. 1096-1108: 
is (continued below) 


LANGUAGE/SYSTEM: pan 6400 SCOPE 
FTN/3600 SCOPE 


are GCM, ALLEGRO, TOGUM. No modifications to IDA program 
made since deck sent to DCPACC in 1972. Current IDA deck 
if of archival interest only since extensive improvements 
have since been made at DCPACC. 


¢ 

* COMMENTS: Central Program of the MEVUNS system. Related programs 
* 

$ 


DOCUMENTATION (continued 


"ANCET Improvements, Final Report, Vol. I," Mary B. Woodside, 
Research Triangle Institute, November 1968 (includes a compre- 

. hensive bibliography of Relevant RTI documents); IDA Report 

r S-394, "Methodologies for Evaluating the Vulnerabilities of 

h National Systems," Vol. I, Part I, Description of Methodologies, 
y | November 1, 1971 


¢ 
&. 
x 
a 
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COMPUTER PROGRAM DESCRIPTION 


NAME: ALLEGRO 

SYNOPSIS: ATTACK GENERATOR 

TYPE: PRODUCTION 

USE: Nationwide Attack Generator 


BACKGROUND: Developed as a rapid attack generator and blast damage 
assessment routine, later modified to include attack 
on an economic data base and with ABM defenses, and 
incorporated with the MEVUNS system. 

DESCRIPTION: Blast only optimization based on LaGrange Multipliers 
and Square Root Damage Low Economic Optimization based 
on County Resolution data. Attack weight for population 
and each economic sector are input. 

INPUT: Population Data Base 

Economic Data Base 


OUTPUT: Punched Cards for GEM input 
Separate set of 100 runs used for MEVUNS Vol I, Part II 
Study 


IDA Run #71, 75, 83 
STORAGE: IDA Card Deck #91 


DOCUMENTATION: IDA Study S-394, "Metholodogies for Evaluating the 
Vulnerability of National Systems," Vol. 1, Part £ 
Description of Methodologies, J. McGill, et.al., 
November 1, 1971. 
LANGUAGE/SYSTEM: FTN/6400 SCOPE 
FTN/3600 SCOPE 


COMMENTS: Available population input tapes based on 1960 census. 


COMPUTER PROGRAM DESCRIPTION 


NAME: ANDANTE 

SYNOPSIS: Detailed Urban Tract Damage Assessment 
TYPE: PRODUCTION 

USE: Study Combined Blast-INR Effects 


BACKGROUND: Developed from Program AGZSEL to include INR inputs 
and to give output emphasizing combined effects. 


DESCRIPTION: Tract population and location data is input. The 
Blast over pressure, INR dose and fatalities and 
‘casualties on each tract are computed and summarized. 
Attack optimization option available. 
INPUT: Parameters 
Tract Location 


OUTPUT: Separate set of printouts 
IDA Printout #96, 119 


STORAGE: IDA Card Deck 99 


DOCUMENTATION: Attached sheets 


FTN/3600 SCOPE 
FIN/IBM COS 


COMMENTS: The version has old blast and INR input routine. 
Current DCPACC version has same basic bookkeeping but 
new blast and INR routine. 


| 
LANGUAGE/SYSTEM: FIN/6400 SCOPE : 
' 


Pr ves 


The majority of subroutines in the program ANDANTE are 


» 


NEVUNS Standard and are described in Chapter III. The parameter 


om, 
a 


input stream is spread somewhat in the program and so will be 
described below. 


Calling 
Card # Subroutine Format Variable Use 


a RUNPAR 20A4 LABEL(I), I=1,20 Label for run printed on output. 


T10 JRAD 0 - Do weapon optimization 
1 - Do Blast-INR evaluation. 


3 A4,6X,110 NNEND Name of last city evaluated- 
stop flag. 


IPUNCH If 1, punch card as output from 
optimization. 


4 I10,F10.5 JPKTP 1, use subroutine FLPKHU for 
probability distance 

0, use subroutine FLPKA for 
probability distance 


ADJSTF Fraction change of mean lethal 
radius (see FLPKA descriptio | 


5 T10 LSTAPE If 1, write output summary as 
Magnetic Tape in addition to 
standard output. 


6 RADCAL I10 LSTC This parameter controls addi- 
tional reading for the next 
case to be run. Values are 

: O = Read new city and weapon 
locations 

1 = Don't read city or weapc 

locations 

f 2 - Read new weapon locations 

% only 

a 3 - Do not read new paramete ;; 

} change parameters by sub- 
routine CHANGE as descri*<d 
below. 


{i unused Describe input on following card. 
8 UF10.5,F10.0,F10.5 YIELD Weapon Yield--MT 


Zp 

’ 

a 

Pa CEP Weapon CEP, n.m. if negative 
. 10 psi optimized burst 


ne) 


« 


rey ity 


altitude 


PSI Mean lethal overpressure, if 
y negative surface burst. If 
both PSI and CEP positive, 
a everywhere optimum airburst 
! pressures 


‘ Calling 
% Card # Subroutine Format Variable Use 
i DEL Weapon Reliability 
4 DESMX Return per weapon end for 
optimization 
FMAXWP Number of weapon end for 
optimization. Either return 
for weapon less than DESMX or 
number of weapons greater than 
FMAXWP will terminate the 
optimization. 
9 T10 NSP Number of tracts output in 
TRDCL 
10 unused Describes input on following card 
1a 8F10.4 D50 Mean lethal dose, rads 
SIG50 Standard deviation of mean lethal 
dose, rads 
PF Initial nuclear radiation protec- 
{ tion factor 
C50 Mean casualty dose, rads 
+ SIGC50 Standard deviation of mean 
f casualty dose 
PSINJ Mean casualty overpressure 
SIGBC Standard deviation of PSIINJ 
as a fraction of RSINJ 
SIGBL Standard deviation of PSI as a 
fraction of PSI 
12 3F20.6 AR INR radiation constants in 
8 BR expression 
‘, oe In R = AtBln P+C(In P)* 
t ; If a city is to be read: 
‘. 1N NEWCTY 1504 NAMEC(I),I=1,15 City name; if the same as NNEND 
3 terminate run 
q 2N 2F10.3,F10.0 Y(I) Tract latitude (if < 0 terminate 
z i read) 
a” : ) X(I) Tract longitude 
a i. . POP(I) Tract population 
If a set of weapon cards is to be read: 
cd 
; 1lW PAYIN 55X,15 IWP Number of weapons to be read 
b OW 15,4F15.6 J Weapon number 
N ; PAYZT(J) Cumulative fatalities computed 
1 | ; during optimization to the 
r ¢ weapon 
: . PAY(Z) Fatalities computed for the weapo 
| . XZ(J) Weapon Longitude 
. YZ(J) Weapon Latitude 


1-89 
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After this input the read process returns to card 6. 


The subroutine change is used to change one or two variables 
as part of a string of runs. For each change a card is read, 
under format F10.0,212, which defines the variables VARB, IBLK, 
ILST. VARB is the new value of the variable to be changed. The 
common block containing this variable is specified by the variable 
IBLK, and the location of the variable in the common block by the 
variable ILST. The values of IBLK and ILST to change a particular 
variable are readily found by reading the subroutine. 

The flow of calculations is clear from the program. The first 
step is reading and documenting of input data. Then the subroutines 
FLPKHU or FLPKA are used to obtain probability of kill as a 
function of distance squared. The results of these calculations 
are placed in the common block /PKPR/. For optimization the calcu- 
lation is done by the subroutine OPTWPN. For evaluation the 
calculations for a single tract are accomplished by the subroutine 
TRDCL and for the entire city by the subroutine RADKL. The input 
output subroutines and control subroutines are quite transparent. 
The other subroutines are all described in Chapter IV. 

The current source deck for the program at IDA includes a 
number of changes to individual subroutines which have not been 
correlated. This program is not currently operational at IDA. 
Operating versions of the program exist at DCPACC and CCTC which 
are similar to this program but have more recent blast overpressure 


and INR distance algorithms. 
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_ FORMAT (.F20.6) _ pect i De 


GaTnl 

To READ PSI anD PSTN) AND RETURN =< 
CONTINUE 
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COMPUTER PROGRAM DESCRIPTION 


NAME: GEM/PADECON 


SYNOPSIS: General Economic Model to Assess Recovery from Nuclear 
Attack 

TYPE: PRODUCTION 

USE: Equilibrium Economic Model--Part of MEVUNS system 


BACKGROUND: This program is the result of an extensive economic 
modeling effort 


DESCRIPTION: A large economic model which includes demand predic- 
tion, supply calculations, production functions, 
capital accretion, inventory, bottleneck calculations, 
etc. 

INPUT: IDA Tapes 795 + 691 

Cards 


OUTPUT: IDA Runs #69 
Separate group of runs 


STORAGE: IDA Card Deck 102 
IDA Tape #767 


DOCUMENTATION: IDA Report S-394 "Methodology for Evaluating the 
Vulnerabilities of National Systems, Vol. I, Part I, 
Description of Methodologies," J. McGill, et al., 
November 1971 


LANGUAGE/SYSTEM: 
FTN/6400 SCOPE 


COMMENTS: A second version of the basic convergence subroutine 
(COBWEB) is IDA Card Deck #103. 


WPecediy. . wer 
G Kiroe BLavh Paper 


COMPUTER PROGRAM DESCRIPTION 


b 


NAME: TOGEM 

SYNOPSIS: MEVUNS Auxiliary Program 

TYPE: Production 

USE: Convert ANCET mortalities to GEM input format 


BACKGROUND: Developed as part of GEM 


DESCRIPTION: ANCET prompt effects mortalities are converted to GEM 
input on a countrywide allocation of damage 


INPUT: ANCET Output Tape 
Geographic Economic Data 


OUTPUT: Punched Cards for GEM input 


STORAGE: IDA Card Deck #165 


DOCUMENTATION: IDA Study S-394, "Methodologies for Evaluating the 
Vulnerabilities of National Systems," Vol. I, Part I, 
Description of Methodologies," J. McGill, et al., 
Nov 1971 
LANGUAGE/SYSTEM: 
FTN/6400 SCOPE 


COMMENTS : 


anata si iii inne 
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COMPUTER PROGRAM DESCRIPTION 


NAME: GEMLET 
SYNOPSIS: Stripped version of GEM 


TYPE: Test 


USE: To run parametric variations of the GEM program to attempt to 
assess the latter's accuracy. Limited to 10 sectors. 


BACKGROUND: Developed in 1974 from the basic GEM program. Much 
faster running and simpler to use version 


DESCRIPTION: Contains basic GEM algorithms but a stripped down 
set of input requirements. 


INPUT: Parameter cards 


OUTPUT: IDA Runs #55 -- 20 runs 
#57 -- 24 runs 


STORAGE: IDA Card Deck #100 
IDA Tape #733 


DOCUMENTATION: "The Economic Recovery Model," R. Michaels, 
December 11, 1973 


ome 


LANGUAGE/SYSTEM: FTN/6400 SCOPE “ 


~ 
+ re 


te 


COMMENTS : 


UP ey oer 


COMPUTER PROGRAM DESCRIPTION 
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NAME: MARATHON 

SYNOPSIS: ABM Deployment Analysis 

TYPE: Production 

USE: Compare optimized ABM and shelter deployments 


BACKGROUND: Developed by E, Pearsall to provide a method of 
analyzing the benefits of an optimized shelter on 
ABM deployment against an optimized attack. 
DESCRIPTION: Double Lagrange multiplier optimization of nationwide 
blast shelter and ABM deployments. 


; INPUT: 


OUTPUT: 


wre 


STORAGE: IDA Card Deck #107 


DOCUMENTATION: IDA Study S-388, "A Study of Active and Passive 
Systems for the Defense of Urban Population Centers," 
Pearsall, Grimm, Pratt (September 1971), "A Lagrange 
Multiplier Method for Certain Constrained Min-Max 

&. LANGUAGE/SYSTEM: Problems," Edward S. Pearsall, Operations Research, 

Vol. 24, #1, Jan-Feb, 1976, pp. 70-91. 


FTN/6400 SCOPE 


COMMENTS: Source deck available, Program authors no longer at IDA. 


COMPUTER PROGRAM DESCRIPTION 


NAME: RESVAL 
SYNOPSIS: Resource Risk Evaluation Program 
TYPE: Semi-Production 


USE: Given an attack and a list of resources, this program determines 
the overpressure level at each resource point and produces 
appropriate listings. 


BACKGROUND: Developed in 1972 as a means of rapidly matching 
weapons and attack. 


DESCRIPTION: An input resource file and attack file are matched to 
give weapon target association. Highest overpressure 
levels are output. 


INPUT: Attack file 
Resource file 


OUTPUT: Reports of risk level 
IDA Run #97 


ee ee 


STORAGE: IDA Card Deck #89 


DOCUMENTATION: Attached description. 


LANGUAGE/SYSTEM: FTN/6400 SCOPE 
FTN/3600 SCOPE? 


COMMENTS: Written to be used with Emergency Broadcast System stations. 
Can be adapted to other resources. 


For a given attack this program finds weapons within a 


certain distance, scaled by weapon yield, of each of a set of 
input resources. For each resource point it prints those weapons 
affecting the result. The attack used has six subattacks and 
results are printed for each of the subattacks. 

The attack data are read first. Each weapon latitude, 
longitude, cosine of the latitude, and scaled critical distance 
are stored. To speed the search procedure the weapons are 
first ordered in latitude. Then the weapons are separated into 
five-minute strips in latitude. For each resource the weapon 


search is over three of these strips. This is accomplished 


through a dictionary which gives the range of weapon numbers, 
ordered in latitude, over these strips. 

When a weapon association with a resource is found, these 
pertinent data are output. A summary gives the overall 


| fraction of resources surviving. 


F 


10 
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PROGRAM RESVAL (INPUTS OUTPUTs TPRES® TPWP) / 
DIMENSION NPLaT ts 00) SWPLON (4300) 9 WPOSS(3390)» COSLAT(3 3300? ’ 
1 LTA(3300) eL78(3 Bo) et rc(3308) eh TD (3300) sLr€ (3300) eLyF (3300) 
2 TORDL (3300) eL TPT(1500) 
—_CaLt NOPCHKF (0) 

p= Spt neur 

— 6! aes oan aS ena 

R = SLTPR Paros, 

Nw. = 4L7PwP Hote 


1OEP = 9 ah pif, 2+ ee tipo. oie @ 
ee ri frtattnk ® 


Ra0cOn 
Radcv 


JcLP 2 ‘ ty afr 
Jclp 2 if ffrtl ahr Popo O 
30161599657 180° 
@ RADCUN/, Sis Boe 
Two s 0 
ee s 0 - ——s eae =a 2 Ss ee 
STOP = 9 < ‘ 
TRSID © 461 dneluin Qotinn Lui pr 10 Mtsajer “v ms) E) 
CTA 
Icts eee 
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BIGLA # 9. 

BIGRAO = je 

LINECT = 12 

WRITE (MOe6) 

FORMAT ( Tile SISA /A940X%9® EBS issue DESTROYED BY SIX OCD ATTACK 
1s® « 4///) 

READ (yRe7) IZILCH 

FORMAT (A10) 

IF(TOEP 2€9,. 3) GO TO 413 

WRITE (MQ015) 

FoRMar ( Ite 50xe ® meer OaTa®) 
GoTo 14 

CONTINUE 

WRITE (mMQ,16) 

FORMAT(///////4 SB8Xe*0EP DATa®) 


ConTIQue 

WRITE (MQ,72) 

WRITE {mos73} 

WRITE (MOe 75) 

CONTINUE é 
Iwe s IwO e 1 

READ( NWey2) WLOSWLM® WLSe WLODs WLOMs WLOSeWYLO» 
1 Lra(rwe)s LTa(rWe) ¢ LTC(IWedes LTO IWC) oLTECIWC)» LTE (IWC) 

ForMAy( 3F3,00Fb002F3e00 Gus F6e2023x0 611) 

TMP = WLD © WLM/60. * WLS/36006 

Tma & TMP@Gne 

WPLAT( THC) © THA 

Te (TMA ,LTo SMLLA) SMLLA & TMa +k 
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TEMP = TMP®R 


eee UNCLASSIFIED #¢0° 
IF( MA .GT. @YGLA) BIGLA a ymMA 
TMPP 2 WLOD © WLOM/A0« @ WLOS/3600. 


aOcoN 


COSLAT(IWC ) = COS(TEMP) #60, 


WeLon(IwC) = 


OST = TeSIO® wy_0een.33333333 


TupP 


IF (OST .GTe BIGRAD) BIGRAD = oS 


WPOSS(IWC) = 
IF (LTE (TWO) 
IF (LTE (Twe) 
IF (LTO (TWO) 
IF (LTC yWC) 
IF (LTB (Twe) 
IF ( EOF (NW) 


SF ea SMLLA/1 
IsF = SF 

IND 2 ISF ¢ 
00 2} J = le 
LTPT(y) = 4 


usT*osT 

eEQe 1 eANDe 
eEme 1 AND, 
EQ. 1 eANDe 
eEQe eANDe 
eEne eAnD. 
eEQ. 0) GOTO 


ae 


LTE(Iwc) 
LrO«TwC) 
LTC rwe) 
LTB«(rWC) 
LrActwC) 
10 


WPLATSTOROLeIWwc) — 


iia a 


Cc 


One 
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oEQe 


1) 


o£Qel) 


oEQe 
At-Py 


I) 
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LYF (IWC) 
Lr&(Iwe) 
LTN(IWC) 
LTc(r1we) 
Lr3(Iwe) 


Ar paofor Spares) Z, 


WwhLAt(10%ec(1)) Aer Leauvet 


Aor Algheot- 
ve 6400 , 
Eo A At 


1 
Isr aubiolinne LORD 


vans STANIARG 


, 


« 900° 


ea pld li 


Ta Check 


, MALAI 090k Cpwed) 


‘ oe 
(Tel 2k pole 


CONTINUE 

Oo 22 J = lelwe 

ILK 2 I@Rplb(¥) 

FAC = WeLAT(ILK)/12. 
eae 2 FAC 

ONTINUE as 
IF(IFAC,LTeIND) GO TO 22 Wal 4 8 FC ‘lok 
LTPT(IT) CONTINAES VALVE OF 4ST WPN OF LAT MORE THAN 120l m ome vate f EFT 6s) 
LYPT(INA) 2 J 

INO # IND * 4 

GO TO 24 


CONTINUE [oar Phe pote 


CONTINUE ne 
IF(ISTOP ,NEe 7) GO TO 36 ee 
REMIND WR fully 
Go TO 1A0 SS, 
AND SUMMARIZE 
CONTINUF 

IATA 20 

TAT zs 

TaTc 

TATOO 

TaTe 

late A 

OMA 999996 
Ome 99999. 
Omc 999996 
Oud 99999. 
OmE 99999. 


OmF = 90999, Abaty _ 


IF( IOEP .EQe 1) GO TO 41 @ "Au! bat Jaf 
READ(NRe37) NMEyONMED® IRSAC » I[SkLae IaMe TEM 3 / 
Le IUTMLsTOTM2s tSLp» ISLMeISLSeISLODsISLOM» ISLOS Aico 
FORMAr( Z2Al10e2A49 24, AlDsAl, 613) 

Tet IRSSC eN&es 4HASSA) GO TO 93 


ee%e (iNCLASSIFTEN e#e@ 12714776 PAGE wo, 0000 


oa 


————— 
4 . 
‘ 
4 


oe UNCLASSIFIED ##0@ 12/14/76 PaGE NO, 0000 
IF (ISLA NE, 40038) 50 TO 23 3 
IsToP # 1 
23 CONTINUE : ] 
If( Isto .NEe 4) GO TO 37 
i WRITE (Qo 38) NME) ONME ZO IAMS TEM 
38 FORMAT(1HOe @FOR @e2A109 © STATION hart Evket ® NOT USED BECAUSE C 
100RDINALES ARE MISSING®) 
GO TO 30 
1 CoNTINUE 
| READ (NR, 42) IRSACs 1AM» LFMy ISLOD# ISLOMy 1SLOS+ISLO+ISLMyISLSs 
—1_NME1L NMED ; 
; e2 FoRMAT ( 2K 0ASe {BX pAb vAdy IX el3o2I202X0 3129410047) 
‘ IF(IRSAC .EQe 4H99T2) ISTOP 2 1 = 


| 37. CONTINUE bad br 
: IsTct # ISTcT « 1 Se eee ae 
ITMP 2 3690 *1SLD « So*rsin e SLs I ga Wraferr 
XTMP 2 YTMP ete ees : : : 2e-eOrtialp. 
SLAT =» xTMP/60, 
i IyvEM = ae # 69*°ISLOm + ISLOS ee 
X7TEM 2 
‘ SLON 2 PEMAaAAie 
~ TEMP = SLAT#RADCY 
| Stcos = COS( TEMP) 406 a : 
0 2 SAT = 12. 


S; 
if Sea ae coe = athoy A bat fo tafe tnlin al 
AC = SFAC - 
1st = Lyprirspac = y)- AA 
[ Lt : fer ISFac = y LtLy fro we (a-tofern 


33 CONTINUE. -_- see See ne en eS ee ee 


‘ IuSE = fOROL(IWN) 
IF (IUSE. .GT. IwC .ORe IUSE LT. 1)-GO TO 60 — 
{ IF (WeLAT(IUSE) GT. stato) 60 70 | 32 "Faw EL 
IwN a IwN ¢ 1 2 os 3 MS, tetera gy set Urs for 
‘ 6O TO 33 
32 CONTINUF 
IuSE # TOROL(IWN) 
| IF (IUSE .GTe IWe .ORe IUSE. oLT. 3) GO TO 60 
DLAT = weLAT(IysE) © SLAT 
IF(OLAT,GT. BIGRAD) GOTO 60 
OLON 2 @PLON (yuSE) © SLON 
IF( = ABS(DLON) LE. g24) GO TO 35 
4 IwN = IwN ¢ ) 
4 GO TO 30 : sae 
ba | 35 CONTINUE 
j DLON = AcS*DLON@(COSLAT(IUSE) + STCOS) 
; | DS0 = OLATOLAt + DLON#OLON 
IF ( DSQ,LEs wPnsS(ruSE) ) GO TO 36 " 
, Pape! Lf ba tr 
a GO T0 35 , 
+ 36 CONTINUE 
i 
St 
A c WPN HITS RESOURCE dices foot 
a 0SO = 0SQ *TPSrH*TPSID/WPOSS; TUSE) 
| IF( LTA USE) ,€Q, 0) GO TO at 
IATA @ IATA © 1 
q t If¢ OS LT. vea ) OMA ® DSO 
' ®) CONTINUE 
IF( LTB8¢ TUSE) ,£Q, 0) GO TO a2 
- TaT8 @ TaTB ¢ y 
} IF( OSQ LT. wma ) OMB # DSA : 
a4 1-143 
5 @o@e UNCLASSIFIED #ee8 12/14/76 pAGE no, 0000 


se 


383 


3a 


55 


66 


60 


91 


92 


93 


Yo 


95 


CONTINYF 

IF ( Le; tuSe) ,EQ. 0) GO 
TaTcC = atc © y 

IF( 0SQ@ «LT. umc ) OMC ® 
CONTINUE 

TFe( LTO¢ puse) EQ. 0) GO 
TaTO 2 alto @ y 

IF( 0SQ eLT. ¥MO ) OMD ®& 
CONTINUE 

IF( LTE¢ ruse) ,EQ, 0) GO 
TATE 2 IATE e 1 

IF( 0§Q «LT. YME ) OME @ 
CONTINUE 

Ie( LTF¢ ruse) ,EQ. 0) GO 
IATF 2 IJATF @ y 

IF( 0SQ «LT. YMF ) OMF 2 
CoNTINUF 

IwN 3 IwN ¢ } 

Go TO 3a 


CONTINUE 
PRESA # 0. 
PRESB 2 
PRESC 2 o. 
PRESD 2 
PRESE 2 
PRESF 3 


eo®e UNCLASSIFIED #ee* 


TO 83 
OSaQ 
TO a4 
Osa 
TO 85 
Osa 
To A6 
Osa 


° 
IF (IATA eNE. 9) ICTA 2 ICTA « } 
IF(IATB eNEwg) ICTS * ICTB « y 
IF¢ TaT¢ eNEey) Icte s rere e 1 
IF (IATO eNE~ g) IctoO 2 ICTO « 1 
If TATE .NEoy) ICTF 2 ICTF « 4 


IF(UCLP oNEs 1) GO TO 87 
IF (IATA eEQe g) GO TO 9} 
DCALL #2 DMA 

DCALL 2 SOQRT(OCALL) 

CaLL CLPRES( DCALL»PRESA) 
CONTINUF ‘ 

IF (IATA ,Eqe 4) Go To 92 
OcALL = OmM8 

DCALL #® SQRT(OCALL) 

CaLL CLPRES( DcALL PRESB) 
CONTINUE 

IF (IaTe .EQe &) GO TO 93 
OCALL 2 OmC 

DCALL # SQRT(OCALL) 

CaLL CLPRES( OcALL ePRESC) 
CONTINUE 

TIF (IATD -EQe A) GO TO 94 
OcaLlL # OMO 2 

OCALL #® SQRT(OcaALL) 

Call CLPRES( DealLsPRESD) 
CONTINUE 

IF (IaATF .EQe A) GO TO 95 
OCALL # OME 

OCALL = SART(OCALL) 

CALL CLPERES( DCALL+PRESE) 
CONTINUF 


ee®e UNCLASSIFTFN ##o* x 
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9e 
87 


72 


73 


78 
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76 


78 
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79 
97 


99 
98 


89 


100 


PAGE NO, 9000 


#e®e UNCLASSIFIED ##e@ 


Ip (laTr .EQe 6) GO TO 96 
OcALL = OMF 

OcaLL # SQRT(DcCALL) 

CaLL CLPRES( DcALLePRESF) 


df od 


If (LINECT eLE. 84) GO TO 72 
WRITE (MQ072) 
__ FORMAT (INL 9/70. 
1 2x0 4H Am 
2 SHLATI TUDE 
a2haTTack RESULTS e~-~eaKILLED 
WalrE(Mas73) 


ee ae 


lH seSXeQHCITY NAME 6X9 1X0 gHRSACe 1X2 gh SLA 9 ; sofrooowrial 
o2X%e GHLONGITUNE 96Xe : 
OmNOT KILLED 


01X— 4H NOs 2X» SHCALLo1X» 4HCALLy 


e27x9 4H NO, 
e2Xe GH O M S 


1 1XsLLHCOORDINATES 
2 6x0 SSHATTs1 
WRITE (MQ, 7S) 
FORMAT( 1H » 32X%9 4H NOw 9 1Xe 4H NOe 


s2X0e gH Dp MS 
ATTe2 ATYe3 ATT.4 Arrye5 ATT«6 


IF(IOEP .€Q, 1) Go TO 76M 
WRITE (MQ974) NME)sNME2ZeIRSACeISLAVIAMs IFMs IUTM),IUTM2 » 
ISLneTSLMs 1SLS— ISLODs ISLOMe ISLOS,IATA, IATBeIATCelLATOSIATED 


FORMAT( 1H, 2A1091X— AbylXy Abyg2X, AG, 1X, Ady 1X, 
1 Aloe Are 2X9 3739 2X9 3139 oxs 6(1592x)) 


WRITE (MQ078) NMEL »NMEZ2eIRSACe IAMeIFMs ISLDe ISLMsISLSeISLOD» 

1 fSLOMs I[SLOSefaTAcIATBelIATCe TATDeIATESIATF 

FoRMAT( LH sAlieATe4XeAde 
2X0 3139 6X0 6(1552X)) 


Sxo2XeAdelxoASelxe  L1Xe2xe313e 


TF (JCLP oNE. 
If TaTa eEQe 9 eAND o IATB -&Qeg eAND. IATC cEQeg eANDeIATO 
1 eEGe O AND « LATE eE&Q@e 9 eANDe IATF.E@.Q) GO TO 97 

WRITE (MQ079) PRESA,PRESBsPRESC+PRESD »PRESE »PRESF 

23HMAXIMUM OVERPRESSURE © 9 6761) 


Athy. 
oufh Aa 


FORMAT( 1H » S@Xxe 


FORMAT(1H ) 
LINECT # LINECT * 1 
LINECT # LINECT * 1 


IF( IATA .NEcO OR, IATB .NE.O) 1012 
IF( TaTao NEeO ,OR, IATB.NE.O OReIATC.NEO) 10)23 @ IC12 
IF( TATAs NEo 6 eQRe IATB eNE.0eQR. IATC.NE,O eORe ITATON 
1 1€14 # cle ¢ } 

IF( ITATAe NEo 6 eOR, IATB eNE. 0 oORe IATC .NEw 0 .OR.IATO oNE.O 


sORe TATEs nE.0) 1015 
IF( TATAeNE. © OR, IATB NE. 0 eORe IATC oNE © 0,OR.TATONE.O 


1 eORsIATE eNEs g 2ORe IATFe NEo g) 1C}6 ® 10)6 *) 
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WRITE (MQ_ 101) 
eaee UNCLASSIFIED e008 


pAGE no, 0000 
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lol FORMAT(IMlgys7y, 9@ NATIONWIDE SUMMARY ONe, 15, RESOURCE POINTS», G 
4/11) 
WRITE (M0102) IcTasICTBeICTCeICTDe reves ice 
102) ForMAr( = 1HOs ®ogINts DEstppYEO By ATTACK 1 =® I5e/ » 
1 1HOe ePOINTS DESTROYED BY ATTACw 2 2® g155/ 9 
2 1H0° *POINTS DESTROYED BY ATTACK 3 2 4159/ 9 
3 1HOe *POINTS DESTROYED By ATTACK 4 s® 915Ss/ 2» 
4 1Hoe *®SO0INTS DESTROYED BY ATTACK S 2® o15y/ 29 
5 1HO® *POINTS DESTROYED BY ATTACK 6 2* elee/ ) 
WRITE(Mp9103) TC12e1C123_ I1C14,1C1591C16 
103 FeRMAT( ///elHae *POINTS DESTROYED BY ATTACKS 1 OR 2 waolSe/y 
1 lHfe *®POINTS DESTROYED BY aTTackS 1 OR 2 OR 3 2# 
2 e1Se/, LHG, *POINTS DEsrROYED By ATTACKS 1 Op 2 Op 3 OR 4 3% 
3 21507, LHe ®POINTS DESTROYED BY ATTACKS 1 OR 2 OR 3 OR 4 OR 
45 2@ 
5S 1509/5 1HO, *POINTS DESTROYED BY ATTACKS 1 OR 2 OR 3 OR & OR 
65 Op 6 w® 415) Atte Sone 
STOP 6400 2. 
END i keen 
SUBROUTYNE CLPRES(DISTsPRES) Fee 
C COMPUTES PRESSURE GIVEN VISTANCE FOROA 1 MT SURFACE BURST Josette nd, hil 
c FIT To VALUE In ENW Be ee eee 
IF( OLST .GTe 90,0001) GO TO « OD be [Oa 
OISsTtT = 0.0001 
4 CaNTINUF 
XLOIST ws aLoGia(OrsT) 
IF =“ eGEe 1,147) GO TO 2 
pe Bw -2.255 
6o°r8°3 
2 ean hee 
SLOPE = -1.825 
3 CONTINUE 
XLPRES = 103010 * SLOPE®(XLDIST = 000596) 
PRES = 10,®*ALPRES 
IF (pRES «GT. 9999.) pRES = 99996 
RETURN L———~— 
END 
IDENT oROER |Z-ghs-, feber 
ENTRY ORDER ear 8 
BYTE EQU 19 Afr f FOR? 
ACQES EQU 1926 of ateel Won 7H AK 
®soYTE EQU «4 FOR ORODERG6 Catlin 
*aCres EQU 64 ; 
USE TALLY 
TLLY VFO «20/TALLY 
TaLLY BSSZ ACRES 
USE aA 
VFO 3A0/SLORDER»30n/30 
. OKOFR PS 
. Sx6 AN 
é SA6 aSEXSv 
SA1 Aj 
Sal x] 
SAl a1. 
S82 Xy 
SAl A}*) 
583 Xj 
S64 OnE 
® SETTING B& TO ADUR OF 9 WORD WOULD 00 ORDER WITHOUT REGARD TO SIGN 
NOSTNE SxX6 al 
sA6 =SBA 
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SX? 82 
SA7 #S68 
Sx7 83 
Sa? =S8C 
SA3 83 
ses x3e1 
NE Bs sMTONE 
Sx6 1 
sae - 2. = 
sa2 aSEySV 
SAO x2 Ses = > 
Jp orOER 
MTONE $86 x3 KEEP LENGTH IN 86 
MXq 6008YTE 
SAg 82 Ag 1S INDICES 
$62 Al B1 ISCOATA) 
$gl 1 
lr A60B1,0RDERX ExIy IF NN LE TO ZERO 
$85 =B) 
$B3 TALLY 
MxXS 1 reAoy PLOOP 
$87 RO 
$X3 Rl 
SA2 84 
SX2 xX20BS 
e ZR X50e0) 
Mx5 0 
x6 85482 
® Now PRESET TNOEy TABLE AND FIx UP DATA — 
PLONP SA] A7¢B2 FETCH DATA ITEM 
IX6 X60X3 
SA6 B7+AQ STORE DATA ADDRESS IN INDEX 
RBX7 X1eX5.- ON OPTION COMPL. LEFT BIT 
SA7 Al So NEGATIVE 1S > POSITIVE 
S87 87481 


ee > 
v Souteatis Mtatioeetetiet 


LT 87986sPL00P 
BX? xS 
SA7 #SCOMPSW 


86 


PRESET SHIFT COUNT 


SB 
© TwROUGH PREL IMINARTES= INDEX WORK VIA B4 (SHIFT) 


MaIn $87 
SX7 

CTLooP SAL 
S87 
AXS 
Bx 
aha 
Ty6 
SA6 


For FREQUENCY CouNTING 
GET A DATA ITEM 


LT B7,B6sCTLOOP 
@ GUMULATE FREQUENCY COUNT 
SB7 eTALLY@acRESel 


sAl 
SX6 


SA6 A 


NSLOOP SAl 
1X6 
SX7 
SA6 


TALLY 
¥1685 


1 
Alebl 
X6oX} 
RATeA} 
Al 


NZ X7eNSLOOP 


# OW SORT 
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587 A623 3 
SAS R2 JUST TO HIDE B2 
SB2 AO B2 AND AQ ARE ROTH CINDEA) 


SOLQOP Sal g7ea0 FETCH INDICES FROM gOTTOM 
SB7 RT7.81 RACK POINTER 
SA2 x1 FETCH DATA 
SX7 a2 SAVE DATA ADORESS 
AXS X2904 SHIFT DATA 
BX @X0*X5 AND GET CURRENT BYTE 


SX2 AT FOR INDEXING purRPOSES 
SA& x3083 FETCH TALLY OF BYTE 
LX7 30 


SX6 x4eB85 BACK OFF TALLY 
SA3 x4e02 GET INDVEX¥TALLY*® 
1X7 X7eX3 PUT 7N THyS DATA ADDRESS 
SAT A3 PUTAWAY 
SA6 A4& 
PL X2eSOLUOP 
SBo AS 
S85 30 
® Ow TIDY UP FOR NEXT PASS 
SB7 R0 | 
xLonp sAl 874A0 GEr T\yOEx 
AX7 X1,85 RIGHT 30 4 
SA7 Al 
AL S87 ATebB1 
LT 87eB6eXALNGP 
MX (a) 
5X4 ACRES 5 = 
SX7 R3 
SX5§ Aled) ‘ 
BX7 X9"Xq 
ALL SA6 AT¢B, CLEAN OUT COUNT 
1X4 X4eX5 
SAT 4600) 
NZ XaoXLL 
« MORE REPAIRS FOR NEXT PASS , 
SBS -By 
SB4 B4edyYTE . 
SX1 A4e60 
NG Xy9MAIN 
# THROUGHe=NOW CLEAN UP ANO EXIT 
SAS COMPSW 


i 


wn we og 


WLOnP = Say ATH? i 


SA6 Al 
@L PL B87+eQL0UP . 
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Sao 
EQ ORDER 
ENTRY 
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x! g 
aSEXSV 
x2 eae = 


ORONS 
360/SLORONS» 3090/3 


pnOns GET RETURN ADDRESS 
nm “TRANSFER TO MAIN ROUTINE EXIT 


ZERO ee ee ee 


L 
exABRTJOB 


y 
s@ORDERSNN LE TO 0° 
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COMPUTER PROGRAM DESCRIPTION 


NAME: ADAGIO 

SYNOPSIS: Nationwide Evacuation Analysis 

TYPE: Production 

USE: To study nationwide evacuation under a variety of assumptions. 


RR 


BACKGROUND: Developed over a number of years to study nationwide 
evacuation. Used as a starting point for Crisis 
Relocation Planning. 


DESCRIPTION: Basic relocation of population from risk areas to 
reception areas to minimize travel distance. A variety 
of options and types of printouts available. 


INPUT: Blast Risk data, Fallout Risk data, 
Population data, Economic data 


OUTPUT: IDA printouts 24-26, 30-36, 45-48, 80, 105, 113 
relocated population data files 


2 STORAGE: see below 


DOCUMENTATION: IDA Paper P-702 "A Study of National Travel Requirements 
for Strategic Evacuation, Leo A. Schmidt, March 1970; 
IDA Paper P-1067, "The Use of the ADAGIO Computer Pre 
gram in Strategic Evacuation Analysis," Leo A. Schmic 

LANGUAGE/SYSTEM: October 1974; IDA Paper P-1183, "Interactive ADAG1O 


see below Computer Program as an Aid to Crisis Relocation 
& Planning," Leo A. Schmidt, November 1975 
{ NAME STORAGE LANGUAGE VARIATION 
* SCATTER4 IDA Card Deck 90 FTN/1604 oo Evacuation Study Program~ 
_- 19 
x ADAGIO-RSAC IDA Card Deck 75 FTN/6400SCOPE Final Version with 1960 Census in 
< RSAC Format 
% . DAGIO-74 IDA Card Deck 85 FTN/6400SCOPE IDA Version of CRP Program 
_ ADAGIO-CRP DCPACC FTN/3600SCOPE DCPA Version of CRP Program 
¢ ~DAGIO-NEPA DCPACC FTN/3600SCOPE DCPA Version of Externally Defined 
Risk Program 

x ADAGIO-75 IDA Card Deck 202 FTN/6400SCOP Current Batch ADAGIO Program 
; SDAGIO-TERM CDC KRONOS Tape FTN/KRONOS Current Interactive ADAGIO Program 
: TKW2212 RATCH 
tr Z A MOT 

FECEUING HEOE Bla Fi LMeeS 

a 


COMPUTER PROGRAM DESCRIPTION 


NAME: TSTGD 
SYNOPSIS: Contour Printer Plot Routine 
TYPE: Development 


USE: To obtain printer plots of values of 2-dimensional functions 
with shading proportional to function value. 


BACKGROUND: Developed to display population densities, fallout 
fields, etc., using only normal printer facilities. 


DESCRIPTION: A function of 2 variables is smoothed, based on 
several smoothing options. Plots can be multipaged 
with provisions for margin, fiducial marks, etc., 


automatically provided by the program. 
INPUT: 


Data files, parameter cards 


OUTPUT: IDA runs 68, 108--plots set of population densities in 
urbanized areas available 


STORAGE: IDA Card Decks#59, 46 


DOCUMENTATION: Memo Eli Williams to L. Schmidt dated 17 April 1973, 
entitled: Subroutine Write-Up 


LANGUAGE/SYSTEM: FTN/6400 SCOPE 


COMMENTS: Copy of source program and documentation furnished to 
DCPACC in 1976 


oe as 


a as 


ee 
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COMPUTER PROGRAM DESCRIPTION 
NAME: JLAM 
SYNOPSIS: Compute Analytic Sums 


TYPE: Single Use 
USE: Computes values of sums for use in analysis 


BACKGROUND: 


N N N 
DESCRIPTION: Computes and prints sums } = oe Oe as YY el Be 
= i aL 


> 
N 1=1 1=1 i= 
; in24l/ 2/2 
i=1 
INPUT: IN PROGRAM 
OUTPUT: 


STORAGE: IDA Card Decks #81, 82 


DOCUMENTATION: IDA Paper P-870, "Analytic Models of Nationwide Urban 
Fatalities from a Nuclear Attack," Leo A. Schmidt, 
July 1972 


LANGUAGE/SYSTEM: RUN(FORTRAN)/6400 SCOPE 


COMMENTS : 


COMPUTER PROGRAM DESCRIPTION 


NAME: TEST 

SYNOPSIS: Fire Spread Model 

TYPE: Development 

USE: To study fire spread in urban tracts 


BACKGROUND: Developed by F. Miercort as a synopsis of the IITRI Fire 
Spread Model. Faster running with multiple weapon inputs. 
Written to be compatible with TELOS program as it existed 
in 1973. 

DESCRIPTION: Fire spread by radiation and firebrands is modeled. 
Detailed bookkeeping by building type and tract of blast 
damage and fire histories, ignitions imposed externally. 
Main coding is in subroutine "FIRE" with main program a 

INPUT: temporary driver 


Data cards 


OUTPUT: Printouts 

STORAGE: IDA Card Deck 131, 217 

DOCUMENTATION: IDA Paper P-988, "Description of a Fast-Running Fire- 
Spread Model," Frederic A. Miercort, December 1973 


LANGUAGE/SYSTEM: FTN/6400 SCOPE 


COMMENTS: Paper contains detailed program description. 


COMPUTER PROGRAM DESCRIPTION 


NAME: POPPOP 

SYNOPSIS: Probabilistic Fire Spread 
TYPE: Development 

USE: Fire Interactions Analyses 


BACKGROUND: Developed as part of Blast Fire Interaction Study as 
an experimental program to assess various probabilistic 
effects 


DESCRIPTION: In a Monte Carlo simulation, an initial set of ignitions 
are made at interactions of anm xn grid. These 
} ignited points can propagate fire in each of the 4 
f cardinal directions each time period with a certain 
INPUT: probability. The resulting fire pattern is printed. 


ia Parameters in program. 


bi OUTPUT: Printouts 


moe 
me 


STORAGE: IDA Card Deck #204 


DOCUMENTATION: Forthcoming paper; attached description 


LANGUAGE/SYSTEM: RUN(FORTRAN)/6400 SCOPE 


\ 
i 
| 
p 
I 
, 
f 


£ 
x COMMENTS : 
; 


r SE 


This program is a simulation of probabilistic ignition 


Pee 


possibilities during a series of time periods, ICNT. In this 
program the array ISTATE(I,J) indicates whether a building located 
at I,J in a grid is burning; ISTATE = 0 means no burning, -1l, a 
burning was just ignited, and +n, the building has been burning 
for n periods. An unignited building may be ignited if one of 
its neighbors (at I-1,J; I+1,J; I,J-1, I,J+l) has been burning 
for NBRN periods or less. This is tested in the section called 
Search Matrix, in the two DO loops ending at statements 111 and 
112. For each neighbor which may ignite a building a random 
number is drawn and compared with PGO or PVARAR(I,J) to see if 
the structure is ignited. 
In the section called Update Matrix the DO loop terminating 
F in statement 201 tests if any buildings may still ignite others. 
If so, the matrix ISTATE is updated in the DO loop terminating in 
statement 202. the time is incremented, and another search is 
made; if not, this trial is terminated. 

There are NTRY trials. Each time a building at I,J is 
ignited the array ISUM(I,J) is incremented by one as a record of 
burnings over all the trials, 

The contents of ISTATE, ISUM, or PVARAR may be printed by the 
various report sections, The remainder of the program is initial- 


= 
. ization or control activities. 
ae ~ 
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aete UNCLASSIFTED ae0e 11/30/76 v PAGE NO, 00 
_____ PROGRAM _PORROR, ;NAUT, OUTPUT) ee ees ane 
Cc 

os ae <2 SS et eae 
Cc 


2 eatin easetiens — PVARAR (60,60) 


BSR oe torts = = 


NTRYP = 260 


MAR 8 Ok cain Fomor Acptth@) = 


C000 6004 0800890 O8RRRDRHEOROODOEE Ss 4 /// V Ob bb blehdbbd 
SOE IIPS 


NITPV = 10_ 


cpepeen s oo 


noranits 2 s ocot fotl porch pratdbdlhe @- 2 
PGOAR(1) = 005 Frorehs Arlette DO 


MQ = 6LOUTPUT | 


SEED = 2.7536 | 
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COMPUTER PROGRAM DESCRIPTION 
NAME: FIRESM 5 
SYNOPSIS: Probabilistic Fire Spread 
TYPE: Development 
USE: Fire Interaction Analysis 


BACKGROUND: Developed from program POPPOP to have a simulation 
closer in nature to the IITRI fire model 


DESCRIPTION: The basic probabilistic model of program POPPOP is 
preserved. A building burning time is determined 
probabilistically. Fire spread by firebrands is modeled 
as well as by radiation. 

INPUT: 


Parameters in program. 


OUTPUT: Printouts 


STORAGE: IDA Card Deck #205 


DOCUMENTATION: Forthcoming paper; attached description 
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This program is developed from program POPPOP but has 
random burning times and firebrands. The array TSTATE(I,J) 
gives the time when the building can transmit ignitions if it 
is already ignited; if TSTATE(I,J) is zero the building has 
not yet been ignited. The search procedure is somewhat different 
than in POPPOP. If the current time period is when a building 
can transmit burning then the section starting at statement 


400 is entered. Each of the four neighbors to the building 


at I,J is tested to see if it is burning. If a neighbor has 

not been ignited, then random numbers are drawn to see if it 
a will ignite by radiation. For firebrands a possible firebrand 
location is found. It is found using the downwind distance 


| probabilities in arrays DISTAR and DELAR. The crosswind distri- 


an 


bution is uniform within the limiting angle PHI. The downwind 


direction is always assumed to the right, 1.e., in the direction 


of increasing I. From the nearest grid point the firebrand 


, 
f 
, susceptibility factor is found. This and the firebrand output 
, factor from the donor building and a random number are used to 
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COMPUTER PROGRAM DESCRIPTION 


NAME: MESHFL 
aw SYNOPSIS: Standard File Format Processing 
TYPE: Production 


RIP 


USE: General purpose program for development and maintenance 
of Civil Defense data files. 


BACKGROUND: Developed to complement and assist Standard File 
Format development. 


DESCRIPTION: The program has a group of subprograms to do 
introduction of data files into standard format, 
merging of a set of data files, file editing, etc. 


INPUT: Up to 10 data files 


‘ OUTPUT: Completed data file 


one 


STORAGE: IDA Card Deck #207 


DOCUMENTATION: Attached description 


LANGUAGE/SYSTEM: FORTRAN/6400 Scope 


cation. Conversion to other machines needs changing 
number of BCD characters per machine word from 10 to 
the appropriate number. 


t 
COMMENTS: Programs operational but not completely up to specifi- 
* 
; 
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A. INTRODUCTION 

The program MESHFL was developed as a general utility 
program to manipulate standard format files. Chapter IV con- 
tains a description of these files; it is assumed here that 
the reader is generally familiar with them. It is also assumed 
in this description that records are identified by FIPS code; 
however, any other alphanumeric identifiers could be used-- 
RSAC code, etc. The program has extensive internal documentation 
including definitions of all significant variables. This sec- 
tion then will only contain a general description of the program 
and its signfiicant subroutines, and a general description of 
the mode of using it. Due to the internal documentation in the 
program, no program annotations will be made. The program has 
several different functions, each performed by an individual 


é subroutine. The first input card (in /, 6110 format) reads 


- 


the following parameters; if any are 1, that subroutine is called. 
At present only 1 function can be performed with each execution 


of the program. 


IMRG Call MERGE to merge several input files into a 
single output file. 


INTRO Call MEET to convert an input file into standard 
> format. 


IEXTRCT Calls EXTRCT to extract records from a file (not 
x yet implemented). 
= 


IPNCH Calls PUNCH to put records in card image format. 
& IEDIT Calls EDIT to do editing on an input file. 
¥ IORDR Calls ORDER to add next record type and record 


count to put a file in complete standard format 
* (not yet implemented). 


The other data read in the main program are the variables 
IBUGA, ..., IBUGH (in /, 8I1 format). These switches turn on 
various types of debugging printout. They should normally all 
be turned off by having values 0. 

The program requires standard input and output media to be 
defined. In addition input files MAT, MBT, MCT, etc., may be 
required for certain runs. Output is on the file TOUT. The pro- 
gram does not care on what physical medium the files are located, 
it being assumed this is defined by the operating system control. 
The input records must be BCD characters and no longer than 136 
characters long, i.e., readable by standard FORTRAN statements. 

This program has been used in the development of the standard 
files described in Chapter 4, in fact program development and 
file generation were carried out simultaneously. It was 
purposely written in standard FORTRAN to simplify transfer 
between machines. In the absence of a powerful system editing 
capability, this program has proved to be a very powerful tool 
in file development. Even with a computer with a powerful 
general purpose file editing capability, it is felt that the 
special purpose features of this program will make it more 
desirable to use in many situations in treating standard format 
files. There is clearly room for additional file handling 
capabilities to be included which would further enhance its 
capabilities. Two such items, clearly, are the use of this pro- 
gram in an interactive mode, and the addition of a random access 


file capability to the sequential file capability here. 


5 amore 
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B. SUBROUTINE MEET 

This subroutine reads records in any format and places 
them into the standard format. The listing starts on page 25 
and continues to page 33. Since the coding depends upon the 
format of the input records, no general purpose coding seemed 
worthwhile and special patches were written for each type of 
input used. After a file was safely converted, then presumably 
these special purpose codes should be discarded. 

The subroutine first reads the variable INTRN (in/, 110 
format) which selects the type of input tape. Control transfers 
then directly to the section of interest. The three samples 
here each read into an input buffer, and write from an 
output buffer. This is done so the next record type can be 
inserted based on input buffer information before writing 
from the output buffer. An alternative would be to use the 
subroutine order to perform this task. These three sections, 
beginning with statement numbers 211, 251, and 271 are all 
direct simple special purpose pieces of coding with no special 
interest to any general reader. They were, in fact, used for 
generating some of the standard format files described in 


Chapter 4. 


C. SUBROUTINE MERGE 

This subroutine merges several input files into a single 
output file, It is listed on pages 7 to 23. The subroutine 
assumes all input files are in FIPS code order. In can accommo- 


date various numbers of records (up to 10 types) for each FIPS 


code in up to 10 input files, and missing records. Several 


Receding Page BLN" © FiLMed, 


options allow different ways of handling missing FIPS codes 
on input files. Once read, the records within a FIPS code 
may be output in any order. 

The merge process is accomplished by using two basic 
buffers--a “next" buffer which contains data just input, anda 
"current" buffer which contains data to be output. When an 
input file is read, data is read into a “read" buffer and 
then transferred to the "next" buffer until a new FIPS code is 
encountered. Thus all the records from a single file in the 
"next" buffer are from a single FIPS code, although "next" 
buffers from different files may have different FIPS codes. 
Control parameters select the next FIPS code to be written on 
the output file, and all records from the "next" buffer are 
moved to the "current" buffer. They are written from the 
"current" buffer onto the output files in an order specified 
by control parameters. Before writing the appropriate next 
record, indicators, etc., are added. If more than one record of 


a particular type is present on an input file for a special 


ny 


IPS code, the additional records are placed in a special buffer. 
They are saved then until the first of the group of multiple 
records is written from the "current" buffer, at which time the 
additional records are taken from the special buffer and output. 


The first action of the subroutine is to read the control 


rameters ILEAD, ILDR, IADVL, IADVX, ISC, IVRY, IWTLSP, ITWLST, 


EPBGEN (in /, 5210, /, 53110, /, 13 format). The meaning 


‘hese parameters is given on page 2 of the program 


or tall 


¢ 
' 


Next the number of input files, NMRGT, is read. Following 


this for each jiuput file the number of records, NMRGA(I), is 
read. Then for this file and each record type, J, the four BCD 
characters identifying the record type NTYPA(I,J) are read, 
followed by the number of data characters in the record 
NCHRA(I,J) and up to 40 characters of description of the 

record which will identify it in output file references. The 
number of characters is reauired since on the output file 
only the number of data characters required for a given 
record type is written, rather than the full 110 possible. 
This can result in an efficient shortening of some output 
files. The output order is defined by specifying for the pea 
record in the output file for any FIPS code the input file 
number in the array NORD(I), and the record type number for 
that input file NORD(J). Following this, control arrays for 
describing missing, INTMSN(I), or not used, IWTBDN(I), records 
are read. The format for these read statements is clear 

from the coding on figures 8 and 9. 

Following the input parameters, a description of merging 
order is written. This is given by the code on pages 9 to 12. 
The starting procedure is controlled on the bottom of 

page 12, which reads into the next buffer and finds a new 
FIPS code. Then the following cyclic procedures is followed: 


Statement 120 transfer data from "next" buffer to 
"current" buffer 


Statement 130 read new data into next buffer 
tatement 100 find "current" buffer FIPS code 


Statement 140 write data from "current" buffer to output 


I-178 


The process is repeated until end of files on all necessary 
input files are sensed. For more detailed analysis of a 
section, the variable descriptions at the beginning of the 
program should first be read from which the fine structure 
in the coding should be clear. 
DB. SUBROUTINE EDIT 

This subroutine edits records of a file in standard for- 
mat. It is listed on pages 35 to 45. The following list 
describes the editing options available. 

1~-Delete a record of given FIPS code and type 


2~-Insert a record at specified FIPS code in proper 
order of types 


3~-Change a record to data specified 
4~-Insert a record after given FIPS code and type 
5--Insert a record before given FIPS code and type 
6--Move a record backwards in file 
7-20--Change a record from one character to another 
2X--Change record by code 
An option allows the same change to be made for each 
record in a state. This subroutine has been used for some 
editing changes, but has not been completely checked for all 
svecified capabilities. 
The input of data for the edit subroutine will be des- 
cribed in order of execution of the read statements. The 


description starts with those on pages 36 of the program 


printout. 


rea 


wre 


The first read is for number of record types, NTYPT, 

ISC as in defined in MERGE, and IPEDT=1 sets printing on 
standard output of the editing corrections. In the next 
read statement, the record label, the number of data char- 
acters in the record, and record description are read for 
each record in the ehaee types specieied for a FIPS code. 
These data items are the same as in MERGE. This is 
necessary if items specified in location by read type 
(change type 2) are to be inserted in the proper place in 
the file. 

The next set of reads are for common change items. 
ICOMNU of these are read. These are specified by a change 
reference number, ICOMNU. The first data character to change 
is ICOMFS(I). All characters are changed to ICOMLS(I). 

The data inserted is ICOMDA(I,L),L=1,7. Any time a change of 
type ICOMNU is specified in the charge list to be read later, 
all characters in the specified range have changed to the 
characters input here. 

The next set of data items to read are state editing 
items. Those are NST of these items. The data read fills 
the arrays ISTLST(I) and ISTTP(I). For state with number 
ISTLST(I) all records are given the change LSTTP(I). Thus, 
for example, if the type change for state number I is 1, then 


all records for the state of Alabama would be delected from 


a file. 


eee ay 


The next set of input read is similar to the state items 

but are for places. The number of changes is NPL, the 

place code to change is IPLLST(I), and the type change is 
IPLTP(I). If IPLFLG(I) is 1, changes are made for all place 
records of the type specified, if 0 only for the first. 

The next set of data read is the individual editing 
items. There are a total of NSPNU of these reads, a maximum 
of 300 is allowed on any single run. For each record change, 
the card images are read. These contain all information 
for the record. Place values for the following arrays, which 
have the listed meaning in 

JSPLST(I)--type of action to be taken, 

JSPNFA(I)--state county FIPS code for editing action, 

JSPNFB(I)--place FIPS code for editing action, 

JSPNRT(1)--record type for correction. 

The amount of valid data in those items depends upon 
the action to be taken; for example, if a record is to be 
inserted as an editorial action, then the entire record must 
be described; but if a record is to be deleted, no such des- 
cription is needed. 

After the data is read, then individual records from the 
file to be edited are read. The records progress through 
three buffers, the M buffer, which contains a record just | 
read, the N buffer which contains a completed record except 


for the next record type, and the K buffer which contains 


@ record ready to write from the output file. As a general 


rule, after a record is read into the M buffer, a search of 


editing instructions is made to see if editing action is 


needed associated with the record in the M buffer, if so, this 


action is specified. If, for example, a record is to be 
inserted, it is placed into the N buffer. Before this can 
be done, however, the N buffer must be cleared. This is 
done by writing from the K buffer and then advancing the 
record in the N buffer to the K buffer. The general pro- 
cedure is one of pushing records through. An action is not 
performed until it is needed to clear a buffer to allow a 
record from an earlier buffer to advance. -The action is 
always initiated by attempting to clear the M buffer so 


another record can enter the system from the input file. 
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GROUP TO PRINT, TF NOT ZERO USE THE CODE wITH THE ITLEAD TH 
FILEe NOTICE ILEaD o ASSUMES THE FILE CODES ARE IN INCREASING 
NUMERICAL ORDERe ALSO ALL RECOORDS ARE USEne 

TaOVL== IF } AOVANCE ILEAD FILE IF THE ILOR RECORD IS NOT PRESENT 
IF 0 DO NOT 

ILORe= THE RECORD NUMBER FOR FILE ILE4D ADVANCING CONTROL 

TaOVXe~* TF 1 ASSUME FILES ARE IN NUMERICAL ORNERSIF ILEAO FILE 
HAS LaRGER VaLUE ADVANCE OTHER FILES TILL THEY MaTCH AND 
PASSED OVER RECORDS» IF 2 ADVANCE OTHER FILES TILL mATCHe NO 
NUMERICAL ORQDERING aSSUMEDs NOTE THrS MAY caUSE FILE TO ADVANCE 
TILL EOF « IF 3 90 NOT ADVANCE OTHER FILES UNLESS A MATCH 1S 
FOUND IN READ BUFFER. ANY OTHER VALUE AcTS LIKE 3 

IvRYe= IF 1 A RECORD TYPE MAY BE REPEATED ON a FILE NEEDING 
SPECIAL HANOLING BY a BUFFER 

Isce* IF 3 COMBINE ~LL STATE AND COUNTY RECORDS TOGETHER IN a 
GROUP» If 0 PLace RECORDS TOO DEFINE A GROUP 


NAN AMNAMAANANAA AN ANAN ANANAAANN AANA KMANNMNAAANAA AA AANA AANA AN ANNANANNNIANANNAAAAAAANAAN 


NMRGT=< NUMBER CF EXTERNAL FILES TO MERGF 


eeee UNCLASSIFIED eee ~~ 11730776 PAGE No. 0n0 


@e#e UNCLASSIFIED *##0@ 11/30/76 : PaGE NO. 006 


NTYPA(10010)eee= A& TYPE CODE FOR J TH RECORD IN THE ITH FILE 
NCHRA(10910)"= Isy NO OF CHARACTERS IN J RECORD OF FILE I 
NnESCR(1Y,109%) w= DESCRIPTION OF I y TH FILE 


eeeDERIVED RECORD/FILE STRUCTURE VARIABLES 


NORDI(100)e* FILE I RECORD y IS THE K TH RECORD TO BE WRITTEN ON 
THE MERGED FILE 133 

NORDJ(100)"< SAME FOR J 

NTYPTJ(100)e=* TYPE OF IY TH RECORD 

NCHRCU(100)~=* NO OF CHARACTERES IN L TH FILE. 

NENKL(10910)e= TYPE Y RECCRD y IS NLNKL IN BUFFER 

NTYPT\= ToTAL NUMBER OF TYPES UF RECORDS TO MERGE 


eeeCURRENT BUFFER VARIABLES 


JFBCU(109)e= FORMAT CONTROL BIT IN CURRENT BUFFER 

JRECTP(190)ee RECORD TYPE OF CURRENT FIPS BUFFER 

JNATR(1LO0)e0 NEXT RECORD OF CURRENT FIPS BUFFER 

JRCTCU(100)<2= READ RECORD COUNT IN CURRENT BUFFER 

JcUFPaA(LO0)e= FIPS CODE IN CURRENT BUFFER» PaRT a 

JcUFPB(100)e* SAMEs PART 8 

JCURDA(100015)e= DATA IN CURRENT BUFFER 

IcF(100)"< FLAG FOR CURRENT BUFFER» 0 INVALIO OaTAe 1 CURRENT FIPS 
CODE DATA 

ICUFPA == VALUE OF CURRENT QUFFER® PART As IE FIPS CODE 
STATE AND COUNTY 

IcUFPB=* VALUE OF CURRENT SUFFER» PaR? BePLACE 


eeeNEXT BUFFER VARIABLES 


JFBNKX(100)"=2 FORMAT CONTROL BIT IN NEXT BUFFER 

JNFCUR(100)e" RECORD TYPE OF NEXT FIPS BUFFER 

JNFNXT(100) 22 NEXT RECORD OF NEXT FIPS BUFFER 

JRCTNX(100)e= READ RECORD COUNT IN NEXT QUFFER 

JNBFPA(LNO)=* FIPS CODE IN NEXT BUFFER® PART A 

JNSFPB(100)—e—= SAmMEs PART B 

JNATDA(100015) "© DATA IN NEXT BUFFER 

INF (100)*e= FLAG FOR NExT FIPS BUFFER, 0 EMPTy NEEDS DaTAy 
1 VALID DATA FROM FILE READ® 2 END OF DATA ON THIS FILE® 
00 NO MORE READING FROM IT 

KcUFPA == VALUE OF NEXT BUFFER® PART As IeEo FIPS CODE 
STATE AND COUNTY 

KCUFPB©* VALUE OF NEXT RBUFFER, PART Be PLACE 

KEPNBA(1O)== FIPS CODESPART Ae OF ITH GROUP IN NEXT BUFFER 

KEPNBB(1Ayee PART B 


eeeSPECIAL BUFFER VARIABLES 


JFBSP(300)e¢ FIAST AIT IN SPECIAL BUFFER 
JSPCUR(3A0)©© CURRENT RECORD TYPE IN EXTRA BUFFER 
JNFSP(300)e= NEXT RECORD IN EXTRA NUFFER 
JRCTSP(390)= RECORD COUNT IN SPECIAL RUFFER 
JSPFPA(300)e¢ FIPS CODE PART a IN EXTRA BUFFER 
JSPFPB (INO e= PART 8 

JSP0A(300445) "= DATA IN EXTRA BUFFER — 
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NMRGA(10) ee NUMBER OF TyPES IN FILE I 3 
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NsPNUee NuMBER OF RECORDS IN SPECIAL SUFFER 

ISPFST(309) "2" FIRST RECOD NU OF L TH RECORD IN SPECIAL BUFFER» 
IF 0 NONE PRESENT == ASSOCIATED WITH CURRENT BUFFER VARIABLES 

ISPLST(3a0) "=" LAST RECORD IN SPEC BUFFER FOR | TH TYPE 
FOR CURRENT SUFFER 

JSPFST(300) "= AS I BUT NEXT BUFFER VARIABLES 

JSPLST(300)©2 aS I gUT NEAT BUFFER VARIABLES 

IcUge= IF 1 ORAW DOWN CURRENT BUFFER IF 2 NEXT BUFFER STORES IN 
SPECIAL BUFFER ORAWOOWN 

MXSPgUse maXIMUM NUMBER OF ENTRIES IN SPECIAL BUFFER 


eeeREAD BUFFER VARIABLES 


JFBHR(10)0" LIKE SPECIAL BUFFER NAMES« USED To HOLD DATA FOR a 
NEXT FIPS CODE Read ON FILE Ie USEW WHEN RECORDS ARE MISSING 
TO TERMINATE NORMAL READS. ‘ 

THR(10)"© THERE IS paTa FOR ITH FILE XEAD TO RE INSERTED ON 
NEXT READ 

IROF (10) ee FLAG TO TELL TRAT JTH FILE HAS BEEN READ ON CURRENT 
READ 

KFPROA(10)©= FIPS CODEsPART Ay OF ITH GROUP IN READ BUFFER 

KFPROB(10)e< SAME PART 8 


eeeMISCELLANEOUS VARIABLES 


Ie USUALLY INOEX To INPUT FILE NUMBER 

Jes USUALLY INDEX To INPUT RECORD NUMHER 

Le= USUALLY INDEX To RECORDS IN ORDER OF OUTPUT 

JRCOCT*= COUNT OF RECORDS WRITTEN ON OUTPUT FILE 

MRD(10)*© EXTERNAL NAMES OF READ FILE 

MNADA(15)e* DATA IN REAQ BUFFER 

MXWRD=< MAXIMUM NO OF OATA WORDS IN ONE READ 

NcHRW=- NUMBER CF CHARACTERS/WORD 

IFLEF(10)e=@ ENO OF FILE S(NSEQD ON ITH FILE TYPE 

MEBNX eMNBEPA eMNGF PB e MNF CUR OMNENXT »MRCTNX gMNXD 4 (15) e@ DATA IN 
TEMPORARY READ BUFFER 

ISTRT=#= FLAG TO INOrCATE START OF FILG MERGE FOR INITIal FILL OF 
NEXT BUFFER 

IsTOP== FLAG TO INDICATE ALL DATA HAS BREEN READ 

NTSTP== VaLUE TO WRITE IN LaST RECORD ON MERGED FILE CURRENT VALUE 
IS SToP 

NTST#= FOR DEBUGGING NUMBER OF RECORDS TO PRONUCE BEFORE ENDING 
RUNe FOR PRODUCTION RUNS SET TO a LARGE NUMBER 

NWRO©= COMPUTED NUMBER OF DATA WORDS YO wRITE ON OUTPUT RECORD 
COMPUTED FROM NCHRCU 

Mp=< STANDARD INPUT FILE» FOR DATA ANO CONTROL 

MQ*= STANOARO OUTPUT FILE 

MS==- PUNCH FILE 

MOP*< PRINTED OUTPUT] EXTRA 

MoT** OUTPUT TaPE FILE FOR MERGED RECORDS 


eeeVARTABLES USED IN EDITING FOUTINE 


JSPFST(300)<© IF ONE THIS CORRECTION HAS BEEN USED» DONT SEARCH 
IT ANY MOFE 

ISPFST(300)-© IF 1 INSERT LTH CORRECTION AFTER NEXT WRITES 
IF 2 AFTER SECOND WRITE 

NTYPIU(100) 02 6S IN MERGE I§ LTH RECOPN rv0E 
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NCHRCU(100)-* AS MERGE» NUMBER OF CHARCTERS OF DATA IN TYPE 
ISPLST(300) "2 PLACE OF RECORD IN LIST 
MRUFFLe= IF 1 M BUFFER KAS VALIO OATA® IF 0 NOT 
NRUFFL©= VALID DATA FLAG FOR N BUFFER 
KRUFFL== VALID DATA FLAG FOR K BUFFER 
N{STe= NUMBER OF INSERTS aFTER NEAT RECORD WRITE 
NSPNU#* NUMBER OF INOIVIDUAL CORRECTIONS TO MaKE 
Jn0Ccee IF 1 MAKE CHANGE CORRECTION(TYRE 3) 
Jp0Ge= IF 1 MAKE COMMON CKANGE TyPE JD0G = 10 ] 
MFBNXe* ETCe Mo Neo OR K BUFFER VARI alne» AS NEXT BUFFER BUT 
CHANGE FIRST LETTER AND NOT ARRAYS 


loko vekelekekehelelelekelskele) 


COMMON / FILOR/ NMRGA(10) + NTYPA(10910) » NORDI(100)» NORDJ(100)¢ 
L NTYP1Yy(100) 9 NUNKL (10910) 2 NDESCR(1001004) » NCHRA(109010)% 
| 2  NCHRCU(100) »sNMRGT»NTYPT 


COMMON / FNBUF? JFBCU(100) »JRECTP(100), UNXTP(100)¢ JRCTCU(100), 
1 JCUFPA(100) 0 JCUFPR(100) s¥CURDA(1OOet&) sICF (100) 
; 20 JFKNX(100)9 JNFCUR(100) eJNFNAT(100) ¢ URCTNX(100) 0 JNQFPA(100) » 
| 3 UINBFPB 6100) sUNXTOA( 100915) es INF (100) 


COMMON /SPBUF/ JFBSP(300), JSPCUR(300}, JNFSP(300) sJRCTSP (300) » 
\ JSPFP A399) 9 JSPFPR(3090) 6 eee cee apres thor nes 
f | TSPFS7(300)9 ISPLST(300)s JSPFST(3001. ySPLST(300) 
c 
? 


COMMON / CONS/ I[8UGA,lBUGBs IBUGC, 1BUGD, IGUGE, IS8UGF, 1BUGG» I RUGH 

; } » MSKAR(109) 9 MSKAsMSKBeMSKCeMSKDs MSKE»MSKF es MPoMQeMSeMOToMOPo 
MRO (10) eMTASMTB OMT COMTDOMTE MTF eMTGeMTHOMTI oMTU 

3 »MXWROONTSTPeNCHRW »MxSPBU 


— 
ie) 


COMMON /MISC/ KNXDA(15) 9 MNXDA(15) 5 NWXDA(15), ICNT»NTSTeISTOP 


LeyRcocT 
(= 
| ¢ 
¢ 6400 UNIQUE 
DaTA MSKaR / 778977008977000089770000008+77000000008e 
; 1 7700000000008 4770000000000008 ¢7700000000000000R» 
| 2 7700000000000000008, 770000000000000000008, 
F { mn — 4 -7777777777777777778 
: aTA MSxB / 33000 0 08/ 
Data MSxe 7 7790000000000 0000008, 
= P DaTA MSxp 7 550000000000000000008, 
i | OaTA MSKE / 77770000000000000000g, 
4 . OaTA MSKF / 778/ 
¢C 
SS ¢ To CORRESPOND TO INPUT FILES ON PROGRAM CARD 
“ DaTA MRO / 3LMATS3LMBTo3LMCT#3LMDT» 3LMET*3LMFT 9 3LMGT, 
. | 1 3LMHTe3LMITeILMUT/ 
i ; DATA MTA / 3LMAT/ 
OaTa Mta / 3LMaT/ 
oe) DaTA MTC 4 3LMCT/ 
* | DATA MTD / SLMOT/ 
: OaTa Mre / ILMET/ 
wi " OaTa MTF / SLMFT/ 
: OaTa MTG / 3LMGT/ 
: r DATA MTH / SLMAT/ 
* | OaTA MTT] / 3LMITZ 
z DATA MTy / 3LMUTZ 
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OaATA MQ / 6LOUTPUT/ 

DaTA MS / SLPUNCH/ 

OaTa MOT /4\ TOUTS 

OaTA MOP / 4LPOUTs 
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eeoeseeSTART EXECUTTABLE CODE cceccccccces 


aAaANMAANAANN 


INITIALIZE 
NTST 5 


3 
lo 
100 
200 
9999999 
50 
20 
Q 


NTST 
NTST 
NTST 
NTST 
NTST 
NTST 
ICNT 


NTSTP = 6HSTOP 
ISToP 2 0 
JRCOCT & 0 


WRITE (MGeg) 
FORMAT (1H19///930X9@ DATA FROM RUN OF FILE MERGE PROGRAM*®s//////) 


angen ao 


AGAIN FOR 6600 NCHRw 2 10 
NCHRW = 10 
MXWRO 2 11 


NSPNU = 0 
MxSPgu = 300 
00 4 L 2 19300 
ISPFST(L) 0 
ISPLST(L) 
JSPFST(L) 
JSPLST(L) 
CONT INUE 


ooo 


READ CONTROL PARAMETERS 


-~ OA0N000 + 


READ(MP911) IMRGsINTROs LEXTRT»IPNCHs IEDI Te IOROR 
1 FORMAT (796110) 
READ (MP,9) IBUGAsIByGBeIBUGC,IBUGD, IBUGE, I BUGF »IBUGGsI8uGH 
9 FORMAT (/9811) 
IF (IMRG eNEe 1) GO TO 2) 
CALL MERGE 
GO TO 1500 
21 CONTINUE 
IF (INTRO oNEe 1) GO TO 22 
Call MEET 
Go TO 1509 
22 CONTINUE 
IF(IEXTRT eNEe 1) GO TO 23 
CaLL EXTRcT , 
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—* , mame 


23 


24 


es 


1500 


ananagaanaanananonanaannanNnaananNnaAaAaANnNananANnNNn 
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Go To 1500 

CONTINUE 

IF(IPNCH eNEs 1) GO TO 24 
CaLL PUNCH 

Go TO 1500 

CONTINUE 

IF(IEOIT eNEoe 1) Go TO 26 
CalLL EDIT 

Go TO 1500 

CONTINUE 

IF(IOROR eNEe 1) GO TO 26 
CALL ORDER 

Go TO 1500 

CONTINUE 


CONTINUE 

STOP 6400 

ENO 

SUBROUTINE MERGE 


BEGIN FILE MERGE SECTION 
* . ° 
J 

* 


s 
uutereeeve 
¢ 


THIS SECTION MERGES SEVERAL FILES. 

OaTa IS Reap INTO THE NEAT QBUFFERe paTa IS WRITTEN FROM THE 
CURRENT BUFFERe USUgLLY ALL paTA FROM a STATE/COUNTY IS 

WITTEN AT ONCE IN THE ORDER SPECIFIED BY INPUTe aFTER WRITING? 
OaTA TS ADVANCED FROM THE NEXT BUFFER INTO THE CURRENT BUFFER, 
AND DATA FROM A NEW ST/CNTY IS READ INTO THE NEXT BUFFERe 

Ip MORE THAN 1 RECORD OF a TYPE IS ON A FILEs IVRY MUSRT Be 
ONEe THEN THE EXTRA RECORDS ARE READ INTO A SPECIAL BUFFER AND 
SaVEo TO ge WRITTEN AFTER THe FIRST Of THE TYPE IS WRITTENe 

ALL RECORDS WITH a PaRTICULaR CODE MUST gE ADJACENT ON A FILEe 
THEY MaY ge IN aNY ORDER WITHIN THE GROUP OF RECORDS WrTH THE Same 
CODE. 


OIMENSION IFLEF (10) eIWTMSN(20) eo TWTBDON (20) 

OYMENSTION JFBHR (10) »JHRCUR (10) SUNFHR (TO) pUHRFOA(10) eUHRFPB(10) » 

1 UJRCTHR(10)_— JHROA(10915) » JHR(10) »IROF (10) 

DIMENSION KFPNBA (10) 9KFPNBG (10) 9KFPROA(10) #KFPRDB(10) 

COMMON / FILOR/ NMRGA(19)» NTYPA(10—10) » NORNI(100)9 NORQY(100) >» 
1 NTYPTY(100) 9 NUENKL (10010) 9 NDESCR(100109%) 4» NCHRA(10010)9 

2  NCHRCU(100) »NMRGT NTYPT 

COMMON / FNAUF/ JFBCU(100) sURECTP(100)« ANXTP(100)9 JRCTCUL1OO) » 


7 
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renee naaaeaaeenanaaccaeacean ence c aca 


anno 


-14% 
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L JCUFPA(100)» JCUFPB (100) sJCURDA (100975) sICF (100) a 
29 JFBNK(100) 9 JNFCUR(100) pYNFNXT(100) 0 JRCTNX(100)» JNBFPA(100)» : 
3 UNBFPB'} 00) eUNXTDA(100915) 9 INF (100) 

COMMON /SPBUF/ JFASP(300)* JSPCUR(300!+ JNFSP (300) sURCTSP (300) » 

1 YSPFPA(200)0 JSPFPR(300)6 JSPDA(300s25) sNSPNUs 

2 TSPFST(300)»s ISPLST(300)» JSPFST(300!, USPLST(300) 

COMMON / CONS/ [8UGasIBUGB9 1BUGCs [BUGDe IQUGEs IBUGF » IBUGG» IBUGH 

1 » MSKAR(10) » MSKAgMSKBeMSKCoMSKD 9 MSKE »MSKFe MP »MQeMSoMOT op MOP 
2 MRD(10) emTArMTBeMTCeMTDSMIE OMTF eMTGOMTHOMII oMTU 

3 sMxWwROeNTSTP»NCHRW »MxSPBU 

COMMON /MISC/ KNXDA(15) 0 MNXOA(15)« NNXDA(15)»9 ICNTsNTSTsISTOP 

1eyRCOCT 


INITIALIZE 
KWIMS 2 4 
ISTRT 2 1 
Isto 2 2H 

on 2 L 2 19100 
IcF(L) 2 0 
INF(L) = Q 
CONTINUE 

On 3 I 2 1910 
IFLEF(I) = 0 
THR(I) 2 0 
CONTINUE 


READ MERGE CONTROL PARAMETERS 


READ(MPe1)) ILEADsILORe IADVL es IADVAsS ISC 
FORMAT (/95110) 

READ(MPe11) IVRye IwTLSPoIWTLSTeIWTMSs IFRGEN 
READ (MP911) IWTRBOPsrwTBoT 


READ FILE DEINITION PARAMETERS 


READ (MP912) NMRGT 

FORMAT (79140) 

NTYPT = 0 

00 13 I = 1,NMRGT 

READ (MP916) NMRGA(T) 

FORMAT (12) 

ITMP = NMRGA(I) 

NTYPT 32 NTYPT # ITMP 

READ (MP 915) (NTYPA(IgJ) 0 J # lo ITMP) 
FORMAT (10 (14 %9A4)) 

READ (MP 916) (NCHRA(I9J) 9y = Le TTMP) 
FoRMAT (1073) 

00 26 y = 1l,ITMp 

READ (MP927) (NDESCRIToJex) eK = 154) 
FORMAT (4410)— 6900 unig 

CONTINUE v 

CONTINUE 


00 17 L = lgNTYPT 

READ (MP 918) NORDI(L) sNORDY (L) 
FORMAT (215) 

I ™ NORMI(L) 
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J 2 NORDU(L) 

NTYPIU(Ly @ NTYPA(Z,¥U) 
NLNKL(I9u) 3 Lb 
NCHRCU(L) 2 NCHRA(I,»J) 
CONTINUE 


NwTMS 2 0 

If (IWTMS .€Q¢0) GO TO 21 
CONTINUE 

READ(MPe22) ITMP 

FORMAT (13) 

IF ‘ITMP ef £20) GO To 21 
NwTMS = NwIMS ¢ 1 
TwTMSN(NwtMs) = ITMP 

Go TO 23 

CONTINUE 


NwT80 = 0 

IF (IWTROP «&Qc0 eANDe IWTBDT 2E£Q.0) GO TO 976 
CONTINUE 

READ (MP 9978) ITMP 

FORMAT (A4) 

IF (ITMP e€Qe 4HZZZZ) GO TO 976 

NwTgD = NwTBD « 1 

IwTgoN(NWTgo) = ITMP 

GO TO 977 

CONTINUE 


PRINT RUN DESCRIPTION 


WRITE (MQ9181) NMRGT 
FORMAT (IHOs20Xe*IN THIS CALCULATION MERGE THE DATA FROM*e139 
1 # SEPERATE INPUT FILES%9/9 30X09 *,,eccccccccccctccscescets///) 


IF(IVRY eNEe 1) GO TO 185 

WRITE (MGe1 88) 

FORMAT(1HOs ® IF THIS RUN A RECORD TYPE MAY BF REPEATED» Up To 300 
1 REPEATED RECORDS PER SET ARE ALLOWED®) 

GoTO 186 

CONTINUE 

WRITE (MQ9)89) 

FORMAT(1HOe *NO REPEATED RECORD TYPES IN A SINGLE SET ARE ALLOWED 
LIN THIS RUN») 

CONTINUE 


IF(ILEAO .NEe 0) GO TO 182 

WRITE (mQel 86) 

FORMAT(1HOs ®USE LOWEST FIPS CODE IN INPUT FILES AS COnE FOR NEXT 
1S€T OF RECORDS WRITTEN wm ALL INPUT RECORDS ARE USED®) 

Go TO 918 

CONTINUE 

WRITE(MQe187) ILEAO 

FORMAT(1HOs ® Take FIPS CODE FOR NEXT SET OF RECORDS aS THaT aSSOC 
LIATED wltTH FILE NO.ws 13 ) 

CONTINUE 


IF (IADVL .NEe 0) GO TO 91) 

WRITE (MGe913) ILEAD 

FORMAT(1hO9® CO NOT SKIP aNY GROUPS OP RECORDS IN LEAD FILE*s 13) 
GO T° 912 
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CONTINUE 

WRITE (MQ9914) ILORe ILEAD 

FORMAT(lHOs® IF THE ®9139® RECORD IS MISSING FROM A GROUP JN THE L 
LEAD FILE®,I39® SKIP THIS GROUP OF RECORDS ANDO ADVANCE TO THE NEXT® 
2 

CONTINUE 


IF(IADVX .NEel) GO TO 916 

WRITE (MQ9919) 

FORMAT (LHOs#ASSUME FILES IN NUMERICAL ORDER@= IF LEAO FILE HAS LAR 
1GER FIPS CODE ADVANCE OTHERS AND DROP SKIPPED RECORDSa«) 

Go TO 918 

CONTINUE 

IF (IADVAX .NEe2) GO TO 917 

WRITE (MQ2920) 

FORMAT(1HOs® IF LeAp FILE COpe DIFFERENT FROM OTHERSsapVANcE OTHER 
1S UNTIL MATCH IS FOUNDs) 

Go TO 918 

CONTINUE 

WRITE (MQ9921) 

FORMAT(1HOe*® OO NOT ADVANCE FILES To “ATCH CODES WITH LEAD FILE UN 
1LESS COOE IS IN READ BUFFER@) 


CONTINUE 


IF (IWTMSeEQ. 1) GO TO 401 

IF (IWTMSeEQe. 2) GO TO 802 

WRITE (MQ9994) 

FORMAT(1LHOs ® IF_& RECORD TYPE IS MISSING FROM a FIPS CODE GROUPIN 
1G DO NOT RECORD THIS EVENT#) 

Go TO 303 

CONTINUE 

WRITE (MQ9g05) 

FORMAT(1HOe ® IF A RECORD TYPE IS MySSING FROM A FIPS CODE GROUPIN 
1G REcORD THrS ON OUTPUT FILE@) 

Go TO 902 

CONTINUE 

WRITE (MQs806) 

FORMAT(1HOe ® ITF A RECORD TYPe IS MySSING FROM A FIPS CODE GROUPIN 
1G RECORU THIS ON TAPE FILE MOP®) 

CONTINUE 

IF(NWTMS 2£Q0e9) GO TO 99) 

WRITE(MQ9903) NwTMS 

FORMAT(/91HO*® # DO NOT RECORD MISSING RECORDS FOR THE FOLLOWING#s 
1 129 TYPES OF RECORDS®s/ ® NO.*#92x— #POSN TYPE DESCRIPTION@, 
27) 

00 904 K = 1»NWTMS 

L = IWTMSN(K) 

I = NOROI(L) 

J 2 NORDUI(L) 

WRITE (MQeg05) KeIWTMSN(K) oNTYPIU(L) » INDESCR(TOU9KK) OKKE 104) 
FORMAT(LH 9 [4e2Xelhe2Xehbs2xe4Al0) 

CONTINUE 

CONTINUE 

CONTINUE 


IF CIWTLSP e€G. 1) Go TO 807 

IFCIWTLST ef Qe 1) Go To 208 

IF ({WTLSo eFQe 2) GO To B17 

IF(IWTLST ef Qe 2) Go TO 818 

WRITE (MQe843) 

FORMAT(1hOe® IF AN INPUT RECORD IS NOT USED 09 NOT RECORD THIS EVE 
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oe 


807 
812 


ell 
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INT®) 

Go TO 809 

CONTINUE 

WRITE (MQo812) 

FORMAT(1HO9* IF AN JNPUT RECORD 1S NO¥ USED RECORD CODE AND TYPE O 
iN OuTPUT FILE®*) 

Go TO 809 

CONTINUE 

WRITE (MQe@ll) 

FORMAT(1lrOe® IF AN INPUT RECORD IS NO¥ USED RECORD COpE AND TYPE O 
IN TAPE FIiE POUT#) 

Go TO 809 

CONTINUE 

WRITE (MQegla) 

FORMAT(1HOs * IF A RECORD IS NOT USED RECORD ALL RECORD INFORMATI 
ON ON OUTPUT FILE®) 

Go TO 809 

CONTINUE 

WRITE (MQs815) 

FORMAT(1HOs ® IF A RECORD IS NOT USED RECORD ALL RECORD INFORMATI 
}ON ON TAPE FILE POUTS) 

CONTINUE 


IF (IWTHOP e€Qe1) GO TO 96) 

Ie (IwTBOT eFQel) GO TO 962 

Ie (IWTg0P e€Q@e2) GO TO 963 

IF(IWTBOT eFQe2) GO TO 966 

WRITE (MQ2967) 

FORMAT(1lHOe® 00 NOT DESCRIBE RECORDS WITH INVALID TYPE COpES*#) 

GO TO 965 

CONTINUE 

WRITE (MQ 0968) 

FORMAT(LHOs ® CESCRIBE ALL RECORDS WITH INVALIO TYPE CODES BY FILE 
1 NO, TYPE CODE, FIPS CODE » ANDO COUNT ON FILE OUTPUTS) 

Go TO 966 

CONTINUE 

WRITE (MQ 0969) 

FARMAT(1NOs*0ESCRIBE ALL DATA FOR RECORDS WITH INVALID TYPE CODE = 
1 TOENTIFY By NexT RECORD SET TO BADT, WRITE ON FILE POuUTe) 

Go TO 966 

CONTINUE 

WRITE (MQ9970) 

FORMAT(1LHOe ® DESCRIBE ALL RECORDS WITH INVALIO TYPE CODES BY FILE 
1 NO, TyPE CODE, FIPS CODE » AND COUNT ON FILE POUTe) 

Go TO 966 

CONTINUE 

WRITE (MQ097}) 

FORMAT (1LHOs*®0ESCRIBE ALL DATA FOR RECORDS WITH INVALID TYPE CODE = 
1 IOENTIFy By NExT RECORD SET TO BADT, wRITE ON FILE OurPuTe) 
CONTINUE 

IF (NWTBO .EQ0e0) GO TO 965 


WRITE (MQe972) 

FORMAT(1HOs ® THE FOLLOWING LIST aRE EXCEPTIONS@ 00 NOT pEScCRI 
18€ INVALID TYPES IN THE FCLLOWING LIST@osollX~— @ NO, 5x9 eTYPE a, 
27) 


00 973 K @ 1eNWTMS 

WRITE (MQ9974) Ke IWTBON(K) 
FORMAT(I1H 910X%9 1495X0A4) 
CONTINUE 

CONTINUE 
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IF (IFBGEN eEQe 1) GO TO 619 

IF (IFBGEN e€Qe 2) Go TO 820 

IF (IFBGEN eEQ@e 3) GO TO 826 

WRITE (MQ,g¢2) 

FORMAT(1HO» *00 NOT CHANGE FORMAT CONFROL BITS INPUT®) 

Go TO 821 

CONTINUE 

WRITE (MQ,_g23) 

peceer snuae *#SET FORMAT CONTROL BIT TO SKIP a LINE FOR EACN New CO 
1UNTy®#) 

GO TO 82) 

CONTINUE 

WRITE (MQoQ24) 

FORMAT( Hos *SET FORMAT CONTROL BIT TO SKIP A LINE FOR EACN NEW CO 
1UNTY ANO TO A NEW PAGE FOR EACH NEw STATE ®) 

Go TO 82) 

CONTINUE 

WRITE (MG9g25) 

FORMAT(1lhOe*® SET FORMAT CONTROL BIT SO NO LINES ARE SkyPPED*) 
CONTINUE 


IF(ISC e&Qe 1) GO To 827 

WRITE (MQ,830) 

FORMAT(1LHOs® REGUIRE COMMON PLACE CODE AS WELL AS STATE AND COUNTY 
1 CODE TO DEFINE A COMMON GROUP OF RECORDS#5/, 
2 (Ieee. JCUFPA‘I) ANO yCuFPB‘I) )*) 

Go TO 828 

CONTINUE 

WRITE (MG9929) 

FORMAT(1lHos ®JUST USE STATE AND COUNTY CODES (JCUFPA(Y) ) TO DEFIN 
1E A COMMON GROUP OF RECORDS, IGNORE PuAce COpEs) 

CONTINUE 


WRITE (MQ0837) 

FORMAT (// 9 lOXePeccccccccccccccccccce tt /9SX9*HESCRIPTION OF INPUT F 
LILES#9/) 

WRITE (MQe935) 

FORMAT(///e)Hoe * FILE RECORD TYPE OUTPUT NOe OF DaTA DESCR 
LIPTION®) 

WRITE (MQ9Q36) 

FORMAT(IM 5» # NOe NO. CODE ORDER CHARACTERS®) 

00 831 I = 1l»NMRGT 

WRITE (MQ9Q34) 

FORMAT (1HO) 

ITM 2 NMRGA(T) 

Do a32 J = leltmu 

WRITE (MQ9833) LeJoNTYPA(I oJ)» NUNKL(I9U) sNCHRA(I9J) 9 

1 (NDESCR(TsJeK) eK # 194) 

FORMAT(LH 9 15918 e2xoA%elBe7lOe7X94A19) 

CONTINUE 

CONTINUE 

peereceveoe! 

FORMAT( /» X9Prcccccccscccccccvcveett//) 


ISTRT = 1 
Go To 130 
CONTINUE 
IsTRT # 9 
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CONTINUE ; 
NOW TRANSFER OATA FROM NEXT BUFFER TO CURRENT BUFFER FOR 
CURRENT FIPS CODE AND SET FLAGS 


00 121 & m= LeNTYPT 
IF(INF(L) eNEel) GO TO 121 

IF (JNBFPA(L) eNEeKCUFPA) GO To 121 
IF(ISC e£EQe1) Go TO 123 

Ie ( JN@FPB(L) eNEs KCUFPB) GO TO 121 
CONTINUE 

JCUFPA(L) = JNBFPA(L) 

JcUFPB(L) = JNBFPBI(L) 

JRECTP(L) = JNFCUR(L) 

JNAXTP(L) = YNFNXT(L) 

JeBCU(L) = SFBNXI(L) 

JRCTCU(L) # JRCOTNX{L) 

Do 122 Li 2 1lels 

JCURDA(L®LL) 2 YNXTpA(LoLL) 


CONTINUE 

ISPFST (L) JSPFST(L) 
ISPLST(L) JSPLST(L) 

JSPFST(L) 0 

JSPLST(L) 0 

IcF(L) 2 1 

INF(L) 3 0 

ENO OF FILE BUSINESS 

I 2 NORDYZ(L) 

If (IFLEF(I) e€Q. 2) IFLEF(I) = 1 

CONTINUE 

CHECK TO SEE IF ALL FILES ARE USED 

DO 124 I = 1*NMAGT 

Ie (IFLEF(T) e€Q. 1) Go To 126 

Go To les 

CONT INUF 

IsTop 2 } 

SINCE ENTERING 120 MEANS TRERE MUST BE VALID DATA IN NEAT BUFFER 
ANO A VALID FIPS COnE THERE IS NOW SOME paTa IN CURRENT BUFFER® 
PROceSS 1T aNO EXrT 

Go TO 140 

CONTINUE 

ICUFPA 2 KCUFPA 

Tc¥FPg 7 KCUFPS 


CONTINUE 

NOW READ DATA INTO NEXT BUFFERe 

IF INF(L) FOR ANY RECORD OF FILE I 3S ONE DONT READ FROM 
THIS FILE 


120 

TROBK 3 } 

CONTINUE 

Tale}. 

CONTINUE 

IF CIFLEF (1) eNE.0) GO TO 131 

NRO ® NMRGA(T) 

ITMP # vRO(T) 

INcT « 0 

00 NOT USe THIS FIle IF ANY INF(I) = ? 


wees UNCLASSIFIED eeoe 3 11/30/76 
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103 


102 


c 
132 


c 
137 


133 


Cc 
c 
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00 851 J = 1eNRO 1 
L # NLNKL (I) J) 

IFC(INF(L) e&@e 1) GO TO 131 

CONTINUE 

Oa 101 J 2 leNRD 

IROF(J) 2 0 

CONTINUE 

IF(IMR(I) eNEe 1) GO TO lod 

TaKE FIRST RECORO FROM READ BUFFER 

MFBNX@ JFBHR(I) 


MNFCUR ® JHRCUR(I) 
MNFNXT @ JNFHR(I) 
MRCTNX # JRcTHR(T) 
MNGFPA # JHRFPA(T) 
MNBFPB ® JHRFPB(I) 


00 103 k = lemxXwRo 
MNXDA(K) @ JHROA(T eK) 
CONTINUE 

KePNBA(I) @ KFPROA(T) 
KePNeB(I) = KFPROR(T) 
THR(T) 2 0 

Jal 

Lo = NUNKL(To6l) 

Go To 135 

CONTINUE 

J20 


CONTINUE 

TRPT 2 6 
Jzsyuel 

L 2 NUNKL (Te) 


CONTINUE 

READ(ITMP,133) MFBNX»MNFCUR »MNENXT »MROTNX »MNGFPASMNBFP Ge 
1 (MNXDA(LL) ott # 14MxXWRO) 

FORMAT (A! AS 1X AS Sol x end gASolxgllatg) 


6400 UNIQUE IS 10 CHAR/WROD ASSUMPTION IN FORMAT STATEMENT %oeooe 


CeoeseeNOTICE THIS READ IS NON@ANSY AND RELIES ON A 6600 FTN READ TO CaLL 


Na aRKANnNAN OMANMAANN 


eaur 


FOR MORE INFORMATION THAN IS ON THE RECORD WITHOUT nHIRE 
RESULTS ANDO WITH THE DATA ON THE RECORD ENTERING VALIDLY 


END OF FILE CHECKs SET INF @ 2 IF EOF 


6400 UNIQUE 

IF (EOF (ITMP).EQ,1) 1345135 

6400 RUN COMPILER BELOW, FIN ABOVE 
IF (EOF eITMP) 1349135 


CONTINUE 

No END OF FILE 

InCT # INCT * 1 

6400 UNIQUE 

THIS IS To CONVERT BLANK*] TO 0°) 

ITM @ MNBFPA eANDe MSKC 

IF (ITM eNEe MSKD) GO TO 147 

MNBFPA 2 MSKB .ORe (MNBFPA .ANDe MSKS) 
CONTINUE 


##®® UNCLASSIFIED ##@ See 11/30/76 PAGE NO. 000 


no 


953 


955 


956 
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ON FIRST READ PRIME NB CODE ARRAY ae 
IF (ISTRY .NExo 1) GO TO 8546 

IF(INCT eNEsl) GO To 854 

KEPNBA(I) = MNBFPA 

KePNBB(L) = MNBFPB 

CONTINUE 


IF NEW FIPS CODE PREPARE TO EXIT 

IF (KFPNBA(I) eNEe MNBFPA) GO TO 852 
If (ISC e€Q. 1) GO TO 3853 

IF (KFPNBB(I) eNEe MNBFPA) Go TO 852 
CONTINUE 


To FINO PROPER gy AND L 

CONTINUE 

IF(MNFCUR e€Qe NTYPTJ(L)) GO TO 139 
Jz Je} 

IF (J eLEe NRO) GO To 145 


INVALID TYPE CODE So RECORD NOT USED. RECORD IF NEEDED 
IF (IRPT .NEel) GO To 951 

IF (IWTQBOP e€Qe 9 eANDe IWTADT 0£Q9) GO TO 952 

po 953 « = leNwWTBD 

IF (MNFCUR eFQe IWTBON(K)) GO TO 952 

CONTINUE 

IF (IWTBOP e&Qe2) GO TO 954 

IF (IWTBDP eNEel) GO TO 956 

WRITE (MQ9955) IeMNFCUReMNAFPA sMNBFPB eo URCOCT 

FORMAT(1H o@ ON FILE *sI129@ INPUT NOT USED FOR TYPE *sAae 
1 * IS NOT VALID|= AT CODE *9ASelXea4e * AFTER RECORO®,16) 
Go TO 956 

CONTINUE 

MNFNXT © gH@AOT 

WRITE(MQ 9133) MFQNXsMNECUR oMNFNXT pMRCTNX oe MNBFPASMNBFPRO 
1 (MNXDA(LL) elt 2 leMXWRD) 

CONTINUE 

IF (IWTBOT e£Qe2) GO TO 957 

IF (IWTBDT eNEel) GO TO 952 

WRITE(MOP » 955) I eMNFCUR*MNG@FPA»MNBFPBs JRCOCT 

Go To 952 

CONTINUE 

MNFNXT © 4HRADT 

WRITE(MOP 9133) MF QANX 9MNE CUR» MNENXT oMRETNX oe MNBFPAPMNGFP RS 

(MNXDA(LL) 9LL ® 2 yMXWRD) 

CONTINUE 

Go TO 132 

CONTINUE 


To ALLOW FOR A RECORD OUT OF ORDER 
IRPT @ } 

Jl 

CONTINUE 

L = NUNKL (I oJ) 

GO TO 146 


J ANO L ARE JUST DEFINED 

CONTINUE 

INF(L) @ } 

NwRO #® NCHRCU(L)/NCHRW « 1 

NEATRA © WNCHRCU(L) e(NWRD = 1) *®NCHRW 
IF(NEXTRA oFQ00) NWRD 2 NWHD = 1 
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SPECIAL BUFFER CPERATIONS 
IF CIRDF (J) eEQ@e 0) GO TO 16) 
PuT paTA IN SPEecIalL BUFFER SINCE MORE THa ONE OF SAME TYPE 
A SPECIAL BUFFER GROUP HAS THE SAME RECORD TYPE AND FIPS CODE 
NSPNU = NSPNU @ 1 
Ip (NSPNU .LEe MXSPBU) GO TO 162 
WRITE (MQe163) MNBFPAeMNBFPByMNECUR 
FORMAT(///e1HOe *¢¢+¢**ERROR STOP» TOO MANY ENTRIES FoR SPECIAL BU 
1FFEReeeeeom, 3Xy @AT FIPS CODE #,A5,A4, #FOR RECORD TypE 9A4) 
STOP 163 
CONTINUE 


IF (JSPFST(L) e&Ge0) JSPFST(L) = NSPNU 
JSPLST(L) = NSPAU 

JF BSP(NSPNU) * MFRANX 
JSPCUR(NSPNU) = MNFCUR 
JNFSP(NSPNU) 2 MNENXT 
JRCTSP(NSPNU) = MRCTNX 
JSPFPA(NSPNU) = MNBFPA 
JSPFPB(NSPNU) # MNBFPB 

on 164 Ly = leNwRo 
JSPDA(NSPNUeLL) 2 MNXOA(LL) 
CONTINUE 

IRPT 2 0 

REFRESH READ BUFFER 

Go TO 137 

CONT INUF 


NORMAL ReaD OF DATA INTO NEXT BUFFER 
IROF (J) 2 } 

JFBNX(L) 2 MFBAX 
JNFCUR(L) = MNFCUR 
JNFNXT(L) 2 MNENXT 
JRCTNX(L) 2 MRCTNX 
JNBFPA(L) 3 MNBFPA 
JNBFPRB(L) = MNBFPRS 

Oo 138 LL = lenwRo 
JNATOA(LeLL) & MNXDA(LL) 
CONTINUE 

Ga TO 132 


FILL READ BUFFER AND EXIT TO a NEW FILE 
CONTINUE 

JFBHR(I) = MPBNX 
JHRCUR(I) = MNFCUR 
JNFHR(I) = MNENXT 
JRCTHR(I) = MRCTNX 
JHREPA(I) = MNBFPA 
JHRFEPB(I) = MNBFPB 
Do 1946 yy = lemxwro 
JHROA(T 9K) & MNXDA(K) 
CONTINUE 

THR(T) # } 

KFEPRDA(I) 2 MNBFPA 
KFPROB(I) = MNBFPR 
Go To 137 


CONTINUE 
ENO OF FILE 
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112 


@aee UNCLASSIFIED ##e0 11/30/76 
IFLEF (I) = 2 
IF NOTHING IN NEXT BUFFER AND NO MORE DATA IN THIS FILE SET 
THE INDICATOR IFLEF (1) 2 1 
Do 943 y = 1sNRO 
L ® NUNKL (Ted) 
IF (INF(L) e&€Q@e1) GO TO 944 
CONTINUE 
IFLer 1) # } 
CHECK ALL FILES 
Do 945 I = 1 »NMRGT 
IF (IFLEF (1) eNEel) GO TO 944 
CONTINUE , 
ALL FILES AT EOF AND NO DATA LEFT IN NEXT BUFFER (NOTICE AT EOF 
THAT THE READ BUFFER MUST be EMPTY) THEN SET ISTOP = ly PROCESS 
CURRENT BUFFER AND EXIT 
Istor = 1 
Go TO 140 
CONTINUE 


CONTINUE 


GROUP VALID OATA FOUND IN THIS FIPS READ» REDO FOR ANOTHER FIPS 
00 947 J = l1eNRD 

L # NLNKL (I ed) 

IF CINF(L) e€Qel) GO TO 948 

CONTINUE 

IF CIFLEF (I) eNE«0) GO TO 948 

NO VaLIO RECORDS HERE@TRY AGAINe 

Go TO ass 

CONTINUE 


GO T0(860+661) »«IROBK 
CONTINUE 
IF (I LT, NMRGT) GO TO 136 


CONTINUE 
BEGIN NeW CYCLE WITH ALL NEXT BUFFERS FILLED» CURRENT gUFFER 
FLAGS = 0 AND CURRENT SUFFERS EMPTY OF VaLID DATA 


FIND CURRE’.T FIPS CODE 


IF(ILEaO .NE&eO) GO TO 11] 

USe LOWEST FIPS CODE IN NEAT BUFFER 
“~CUFPA ® 5499999 

KcUFPB ® 419999 

Oo 112 L @ leNTYPT 

IF(INF(L) oNEe 1) GO To 112 

NOTICE ToHaT THIS ASSUMES ALPHABETIC ORDERING IMPLIES NUMERICAL 
ORDERING 

TE (KCUFPA .GTe JNBFPA(L)) GO TO 113 
IF (ISC eFQel) GO TO 112 

TF (KCUFPR 6GTe JNBFPB(L)) GO TO 113 
Go To 112 

CONTINUE 

KCUFPA = JNAFPA(L) 

KcUFPB © JNAFPBIL) 

CONTINUE 


ees UNCLASSIFIED ***#* = = -11/30/76 
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#e®@ UNCLASSIFIED #### 11/30/76 
WITH ILEAD 0 NO RECORDS ARE NOT USED 
Go TO 115 


CONTINUE 

USE FIPS OF ILEAD FILE 
KCUFPA ® KFPNBA(ILEAD) 
KcUFPS8 = KFPNeB(ILEAD) 


IF(IAOVL .NEe 1) GO TO 119 

Ip NEXT BUFFER DOES NOT HAVE a ILDR RECORD OF FILE ILEaDe 
AOVANcE THIS FILE BY GROUPS UNTIL IT DOES 

LL = NUNKL (ILEADe ILOR) 

IF CINF(L) e€Qe1) GO TO 119 

IF CE®LEF(TLEAD) e€Q. 0) GO TO 857 

Go TO 1200 AND END IT abt 

Go TO 1500 

CONTINUE 

I = ILEAD 


CONTINUE 

ANVANCE I FILE ONE » RECORD RECORDS BEING DISCARDED 
NRD @ NMRGA(T) 

Oo 858 J = leNRO 

L 2 NLNKL (IJ) 

IF CINF(L) eNEel) GO TO 958 
KwIMS 2 1 

Go TO 198 

To RECORD a RECORD aBOUT TO BE DROPPED 
CONTINUE 

INF(L) 2 0 

Ie (USPFST(L) e&€Ge0) GO TO 858 
INU ® JSPLST(L) = JSPFSTI(L) « 1 
00 869 yy = l,Inu 

ITMP = JSPFST(L) * yy = 1 
JFBCU(L) = JFBSP(ITMP) 
JRECTP(L) = JSPCUR( 7 TMP) 
JNATP(L) = YNFSP (1 TMP) 
JACTCU(L) 2 JRCTSP( TMP) 
JcUFPA(L) = YSPFPA( TMP) 
JcUFPBIL) = JSPFPR( TMP) 

Do 176 LE = lenwRo 

JCURDA(LoLL) 2 YSPOA(ITMPeLL) 
CONTINUE 

KwTMS 2 2 

Go TO 198 

Tm RECORD DROPPED FROM SPECIAL BUFFER 
CONTINUE 

CONTINUE 

IsTPp 2 2 

Icle = 2 

GO TO 194 

TO ADJUST BUFFER STORAGE 
CONTINUE 

CONTINUE 

TROBK a 2 

GO TO 855 

To READ ONE GROUP FROM I TH FILE 
CONTINUE 

GOTO(1119116) »sKWTMS 

CONTINUE 
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120 
NOW CHECK POSITIONING OF OTHER FILES 
CONTINUE 
Isle} 


IF (CIFLEF (I) e€Qel) GO TO 116 

IF (Il e€Q@e ILEAD) GO TO 116 

If (IADVX eNEe 1) Go TO B62 

ASSUME NUMERICAL ORDERING ADVANCE TILL MaTCH 
IF (KCUFPA eGTe KFPNRA(I)) GO TO 863 
IF(ISC efQe 1) GO To 116 

If (KCUFPR eGTe KFPNGB(I)) Go TO 863 
Go TO ll«4 

CONTINUE 

No ORDERING USEDe ADVANCE TILL MATCH 
IF (IADVX eNEs 2) Go To 864 

Ip (KCUFP, eNEo KFPNRA(I)) GO TO 863 
IF (ISC e&Qe 1) GO To 116 

IF (KCUFP3 eNEe KFPNggil)) GO TO 863 
Go TO lle 

CONTINUE 

ADVANCE ONLY IF MATCH IN READ BUFFER 
TE (KCUFPA eNEe KFPROA(I))? GO TO 116- 
Ie (ISC e€Qe 1) GO To 863 

Ip (KCUFPRB eNEe KFPRpg(I)) GO TO lle 
Go TO llé 

CONTINUE 

IF (I eLT e« NMRGT) GO TO 114 


CONTINUE 


IF (ISTRT .EQe1) GO TO 19 


CONTINUE 
NoW WRITE pata FROM CURRENT BUFFER ONFO OUTPUT FILE IF BUFFER FLaG 
1S ONg&e IF NO AEXT BUFFER FLAGS ARE + END PROGRAM AFTER WRITES 


FrRST FIND TYPE OF FIRST 1 FLAGGED RECORD IN NEXT BUFFER 


IF(ISTOP .EQ» 1) GO TO 867 

oo 141 L = ly NrYPT 3 

IF (INF(L) eNFel) GO TO 141 

IF( KCUFPA “Re. Jara (Ly 160 TO 44] 
Ie (ISC e&Qe1) GO TO 148 

Ip (KCUFPR eNEe YNBFPB(L)) GO TO 141 
CONTINUE 

NTLST @ JNFCUR(L) 

Go TO 142 

CONTINUE 

IsToP = 1 

CONTINUE 

NTLST = NTSTP 

CONTINUE 


NOW FILL IN NEXT RECORD VALUES 
O00 143 L = JosNTYPT 
IF (ICF(L) oNEe 1) GO TO 143 
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dr: 


LST SL 
IF (L e&Qe NTYPT) GO TO 143 
ITMP @ Lo 1 
00 144 LL = ITMPeNTyYPT 
IF (CICF (LL) eNEel) GO TO 144 
JNXTP(L) = JRECTP(LL) 
Go TO 143 

144 CONTINUE 

143 CONTINUE 

c NoW FILL IN FOR LaST RECORD TO BE WRIFTEN FOR THIS Time 
JNATP(LST) a NTLST 

149 CONTINUE 


GENERATION OF FIRST BIT PRINT CONTROL 
IF (IFBGEN e&Qe 9) GO TO 932 
AND LEAVE FIRST BIT ALONE 
IF (IFBGEN eNE*e3) GO TO 932 
Oo 933 L = leNTYPT 
JFBCUIL) = Ih 
Cc ALSO FILL SPECIAL BUFFER SPOTS WITH NW SKIP LINE 
IF (ISPFST(L) e€G0e0) GO TO 933 
. INU # ISPLST(L) © ISPFSTI(L) «+ 1 
Oo 937 Li = ernu 
Ly 3_ISPeST(L) * LL = 1 
JFBSP (LU) = 1H 
937 CONTINUE 
933. CONTINUE 


¢ 30 TO 931 

7 932 CONTINUE 
¢ PuT @LANK LINE SKIP INTO FIRST RECORD 

IFGO = 0 


00 934 L = leNTYPT 
Ie (IFGO eNEe0) GO To 935 
IF cicr(b) ,NE.1) GO TO 934 
IFGO 7 1 
IF (IFBGEN eNEo2) GO TO 936 
ITM @ JRECTP(L) eANDe MSKE 
IF (ITM eNEe ISTO) GO TO 936 
Isto = ITM 
JFBCU(L) = HI 
Go TO 938 
936 CONTINUE 
JFBCU(L) = 1HO 
Go TO 938 
935 CONTINUE 
JFBCU(L) = JH 
938 CONTINUE 
€ ALSO FILL SPECIAL BUFFER SPOTS WITH NQ SKIP LINE 
IF(ISPFST(L) e&Ge 0 ) GO TO 936 
INU # [SeLST(L) = ISPFST(L) » 1 
Do 939 Lb; = letnU 
Lu 3 ISPFST(t) ust 
JFesP(ty) = tH 
939 CONTINUE 
334 CONTINUE 
931 CONTINUE 


Mm? ote 


150 CONTINUE 
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Do 151 L so LeNTYPT 

IF(ICF(L) eNEel) GO TO 152 

NwRO = NCHRCU(L)/NCHRW « 1 

NEXTRA = NCHRCU(L) = (NWRO 1) ®NCHRW 

IF (NEXTRA e£9e0) NWRO 2 NWRO = 1 

KNXTP @ UNXTP(L) 

Te (IVRY eNEel) GO To 196 

Ip (ISPFST(L) e€G09) GO TO 196 

ISTR # JNXTP(L) 

KNATP 2 JRECTPI(L) 

CONTINUE 

JRCOCT = JRCOCT * 1 

WRITE(MOT. 156) JFBCU(L) » JRECTP(L) » KNATO eJRCOCT# UCUFPAI(L) » 
1 JCUFPB(L)» (JCURDA(LeLL) slim leNwRo) 

6400 UNIQUE IS 10 CHAR/WRN ASSUMPTION IN FORMAT STATEMENToo*ooe 
FORMAT (Al gAbolxgAGoISo lx eASeAbolxoll AIO) 


NOW CHECK SPECIAL BUFFER 

IF(IVRY eNEel) GO To 157 

IF (ISPFST(L) e€Q00) GO TO 157 

INU 3 ISPLST(L) = ISPFSTI(L) « 1 

00 171 JJ = LleINU 

Lz 7 Ju * ISPFST(L) = 1 

TF (JJ eEQ. INU) GO TO 172 

KNATP 3 JRECTP(L? 

Go TO 173 

CONTINUE 

KNXTP # ISTR 

CONTINUE 

JRCOCT = JRCOCT * 1 

WRITE(MOT, 156) JFBSP(LZ)» JSPCUR(LZ) 2 KNXTP» JRCOCT9JSPFPAI(LZ) » 
1 JSPFPBILZ) » (YySPOA(LZeLL) oLL = lenweRD) 


CONTINUE 


NOW FLUSH SPECIAL BUFFER OF JUST WRYTTEN RECORDS AND AnJUST 
ACCOUNTS 
Ics 2 1 
IsTPp 2 1 
GoTo 194 
CONTINUE 


CONTINUE 


IcF(L) 2 9 
Go To 151 


If REQUESTED RECORD THAT a RECORD IS “MISSING FROM NORMaL GROUP 
CONTINUE 

IF (IWTMS .€Qe0) GO TO 181 

IF (NWTMS .EQ_ 9) GO TO 15a 

Do 159 Ly = leNWTMS 

IF (L e&GerWTMSN(LY))GO TO 151 

CONTINUE 

CONTINUE 

IF (IWTMS .E£Qe2) GO TO 153 
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WRITE(MO 4 154) I[CUFPAsTCLFPReNORDI(L) »sNORDJI(L) oL eNTYPTJ(L) #URCOCT 


FORMAT (1H g@NO CATA AT COCE was ASg]¥-44 * FILE@,I3,8 RECORDe,13, 


#@** UNCLASSIFIED **## = 41/30/76 


PaGE NO. 000C 


179 


Ke MNnNaN000 


oo 
> 


875 


879 


177 
175 
178 


378 


377 


#e@@ UNCLASSIFIED #eee 11/30/76 PAGE NO, Ont 
1 ® POSITION@sI39*® TYPE *eh40® AFTER®eI6e® RECORDS*#®) a 
Go To 151 a 
CONTINUE 


WRITE (MOP, 154) ICUFPA®ICUFPBeNORDI (L) sNORDJ(L) eLoNTYPLU(L) eURCOCT 


CONTINUE 


TEST FOR END OF MERGING 

IF (URCOCT eGTe NTST) GO TO $238 
IF (URCOCT «GTe NTST) GO To 1500 
IF (ISTOP Neel) GO TO 120 
CONTINUE 

ENOFILE MOT 

REWIND MoT 

Go TO 1500 


BEGIN SPECIAL ROUTINE SECTION 


STEP DOWN STORAGE IN SPECIAL BUFFER 
CONTINUE 

IF (ICUS .€Q.2) GO To 875 

InmFST = :SPrSTiL) 

IBLST = ISPLST(L) 

Go TO 879 

CONTINUE 

IaFST = JSPFST(L) 

InLST = jSPLST(L) 

CONTINUE 

IoWN 2 IBLST = IBFST * } 

TOY # NSPNU © JALST 

IF (IOV efQe0) GO TO 178 

oo 175 yk a@ lyzov _ 

ITA = [BFST * Jk © 1 

IT8 2 IBLST * UK 

JFBSP(ITA) = JFHSP(TTSR) 
JSPCUR(ITa) # JSPCUR(ITA) 
JACTSP(ITA) 2 JRCTSP (IT) 
JNFSP(ITA) = JNFSP(7TA) 
JSPFPA(ITA) & JSPFPA(ITA) 
JSPFPB(ITA) # JSPFPA(ITH) 
Do 177 LL = lemxwao 
JSPDACITAsLL) 2 JSPpACITbeLL) 
CONTINUE 

CONTINUE 

CONTINUE 

00 876 JK # J »NTYPT 

Ie (JK eNEs L) GO TO 877 
IF(ICUB .EQ.¢) GO To 878 
ISPFST(L) 2 0 

ISPLST(L) = 0 

Go To a7! 

CONTINUE 

JSPFSTI(L) 3 0 

JSPLST(L) = 0 

CONTINUE 


#e@® UNCLASSIFIED ®*** ~~ 11/30/76 PAGE NO. 000¢ 


#e*® UNCLASSIFIED ##9@ 11/30/76 PAGE NO. 0n0L 
IF (ISPFST(UK) eL Te IBFST) GO TO 874 a 
ISPFST(UK)® ISPFST(UK)= IDWN 
ISPLST(JK)2@ ISPLST(UK)@ IDWN 
874 CONTINUE 
IF (USPFST(JK) eL Te IBFST) GO TO 876 
JSPFST(UK)= JSPFST(UK) © IDWN 
JSPLST(UK)=S JSPLST(UK) © IOWN 
876 CONTINUE 
NSPNU = NSPNU © IDWN 
Go T0(192,871) »1STPD 


NOW CHECK FOR wARITEING DISCARDED RECORDS 
98 CONTINUE 
IF (IWTLSP e&Ge 9) GO TO 126 
IF (IWTLSP.NEel) GO TO 125 
WRITE(MQ@ » 118) JNFCUR(L)» JNBFPA(L) eUNBFPBI(L)» JRCOCT 
118 FORMAT( 1H »¢ ® INPUT NOT USED@== TYPE #9449 @ CODE #9ASy1lXeAdy 
1 # LAST RECORD NO wWaS #,15) 
Go TO 126 
125 CONTINUE 
ITMP #@ 4HOISC 
NWRD # NCHRCU(L)/NCHRW @ 1 
NeEXTRA = NCHRCU(L) = NWRO*®NCHRY 
Ie (NEXTRA e€@e0) NWR 2 NRRO = 
WRITE (MG 9456) YFRNX(L) »UNFCURIL) *£TMPy IRCOCTs UNBFPA IL) pUNBFPBIL) # 
1 (CUNXTOA(L®LL) oLL # leNwRo) 
126 CONTINUE 
TF (IWTLST e€Qe 0) Go TO 117 
IF CIWTLST eNEel) GO TO 127 
WRITE (MOD, 118) JNFCUR(L) » JNBFPA(L) eJINGFPB(L) ® JRCDCT 
Go To 117 
127 CONTINUE 
ITMP = 6HOISC 
NWRO # NCHRCU(L)/NCHRW @ 1 
NEXTRA ® NCHRCU(L) « NWRO®NCHRW 
IF (NEXTRA e€Qe0) NWRO 2 NWRO = 
WRITE (MOP 156) JFBNx(L) »JNFCUR(L) oI TMP, JRCOCT, INBFPA(L) »sJNBFPB(L) » 
1 CINXTOACL®LLI PLL & 1 9NWRO) 
} 117 CONTINUE 


R | Go T0(8590870) » KWTMS 
Cc 
: C 
bs c ENO OF FILE MERGE SecTION 
| Cc 
if | ¢ 
we 1500 CONTINUE 
| & Re TURN 
| END 
It | SUBROUTINE PUNCH 
[2 c 
Cc 
prt | c 
| c THIS SECTION PUNCHES CARDS 
¢ 
& ¢ 
a COMMON /SPBUF/ JFBSP(300)» JSPCUR(300!»9 JNFSP(300) sURCTSP(300)» 
{ 1 JSPFPA(200)» JSPFPA (300), JSPDA(30001S) »NSPNUs 
n 2 SPFST(300)s rSPLST(300)+ USPFST(300)»5 ySPLST(300) 
* COMMON + CYNS,/ TBUGA,TBUGR» 1BUGC, [BUGQ, 1 8UGE, IBUGF » 1BUGG» 1 QUGH 


1 § MSKAR(10) 9 MSKAsMSKBOMSKCOMSKD9 MSwFeMSKF es MP9MQ9MSPMOT OMOP® 
eee UNCLASSIFIED #000 | 11/30/76 PAGE NO. 000 


nan 


714 
712 


Tl 


##®@ UNCLASSIFIED #*#9@ 11/30/76 


2 mRO(10) eMTASMTBOMTCoMTIDOMTEOMTF oMTGOMTHeMTI eo MTU 
3 yMXWROeNTSTP»NCHRW »MXSPBU 


COMMON /MISC/ KNXDA(15) 9 MNXDA(15)® NNXDA(15)° ICNT*#NTST#ISTOP 


leyRcOcT 


INOT = 4HPT.8 

NENCH = 0 

ITMP = MTq 

READ (MP e714) ISC eIPRT 
FORMAT (793110) 

CONTINUE 

READ (MP97)1) ITAsITasITC 
FORMAT (A%-A50A4) ; 

IF (ITB e€Qe SHSTOP )GO TO 713 
NPNCH # NPNCH @ 1 

IF (NPNCH GT. 300) STOP666 
JSPCUR(NPNCH) ® ITA 
JSPFPA(NPNCH) = ITB 
JSPFPB(NPNCH) # ITC 


Ga To 712 

CONTINUE 

CONTINUE 

READ(ITMP.729) Se ee ee eee 
1 (MNXDA (LL) ‘hl = 1 MxwRo 

FORMAT(A1¢AS et XeASez5e IxeAS Abe lx 11AT9) 


Te (EOF (ITMP) .E0,1) 731,732 

6400 RUN COMPILER BELOWs FIN ABOVE 
IF (EOF eITMP) 7319730 

CONTINUE 

On 721 K s 19NPNCH 

Ip (USPFPA(K) eNEe MNBFPA) GO TO 721 
IF (ISC .£Q.,1) GO TO 722 

Ie (USPFPB(K) eNEe MNBFPB) GO TO 721 
CONTINUE 

Ip (JSPCUR(K) eNEe MNFCUR) GO TO 72) 
Go TO 723 

CONTINUE 

Go TO 720 


CONTINUE 

PUNCH THIS RECORO 

DECODE (109724e9MNXDA(6)) ITASITS 

FORMAT (A4,A6) 

WRITE (MS9/26) MEBNX»MNECUR®MNENXT oe MRCENX¢ MNBFP Ae MNBFPB, 
1 (MNXDA(I) syaleS) ofTA 

FORMAT (ST eA 0LXsASo TS 91 Kedd oS eX 9SA100AS) 

WRITE (MS 727) ITB, (MNXDA(I) 9» 187011) eo SNOT »MNECUR »MNBFPA 
FORMAT (Ags SA109 6Xe Age2x* hae 2XeAS) 

Te (IPRT eNEe 1) GO TO 728 

WRITE (MQe736) MEBNX «MNF CUR »MNENXT oMRCENX » MNGFPA oMNBFP Bg 
1_(MNXOA(T) otal05) ofTA 

FORMAT ( Ly sAlsAay1x, Ads, T5 91% 9AS A491 xX 95A105A4) 
WRITE(MG735) ITBs (MNXOA CL) 9127911) # fNOTsMNECUR®MNBFPA 
FORMAT(1XeA69 SALO® 6X9 Ad92X9A492K9A3) 

CONTINUE 

GO TO 720 

CONTINUE 


eoee UNCLASSIFIED #*4- ~=——-11/30/76 
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l #e@e UNCLASSIFIED ##ee 11/30/76 PAGE NO. 0000 
[ 
C a 
Cc ENO OF FILE 
REWIND ITMP 
| c 
c 
RETURN 
END 
SUBROUTINE MEET 
{ ¢ 
Cc 
Cc 
(> THIS SECTION TO INTROOUCE FILES INTO FHE SYSTEM AND PUT INTO 
| C STANDARD FORMAT 
€ INCLUDE HERE CODING SPECIFIC TO THE FILE TO ge INTRODUCED 
OTMENSION OCMOSE (693)? 
€ 
| COMMON /SPBUF/ YFBSP(300)s JSPCUR(300) + UNFSP(300) sURCTSP (300) » 


1 ySPFPA(200) 9 ySPFPRA(300)» YSPDA(3009%5) »NSPNUs 

2 1SPFST(300)+ ISPLST(300)s JSPFST(3001, ySPLs7(300) 
. COMMON / CONS/ IBUGAsIBUGR» IBUGC, IBUGO, IBUGE, IBUGF» 1BUGGe 1 BUGH 
ka | * MSKAR(19) 9 MSKAsMSKG9MSKCeMSKD® MSKEsMSKFs MPyMQeMSeMOTOMOP? 
’ MRO (10) oMTASMTBOMTCOMTDOMIEOMIF oMTGOMTHeMI I oMTU 

3 sMXWROsNTSTPeNCHRW »MxSPBU 
COMMON /MYSC/ KNXDA(15) 9 MNXDA(15) 9 NNXDA(1S)»9 ICNTeNTS7>ISTOP 

| leJRCOCT 


SH eFOFHOSHHHS ES HHHHSH HH SHHHHHEHAELOHHHTEHTHEHREHSHEHOHHHHTHEEEHH EF OEEe 


THIS SECTION TAKES a NEW FILE AND PUTS IT INTO STANDARD FORMAT 


VaRIOUS TYPES OF INPUT TAPE ARE NUMBERED BY INTRN 

INTRN 2 1 IS ANCET CITY OATA BASE® 1974 POPs NCPACC TAPE NO 5560 
INTRN 2 2 CCBO DATA SELECTION FROM IDA TAPE NOe 669 

INTRN 3 3 FeQe AND MCD ALAST RISK FROM ADAGIO 74 INPUT TaPE 


A GO TO STATEMENT ALLOWS FOR THIS 
INPUT ON MTA 


INITIALIZATION 
REAQ(MP9S01) INTRN 
ol — FQRMAT (e710) 


GO TO(211,251,271 ,300 ),INTRN 
11 CONTINUE 


ANCET INPUT TAPE FORMAT 
SkIP THREE HEADER RECORDSe } SYSTEMs 2 ANCET 
READ (MTAS213) IZIL 
READ (MTA9213) TZ2TL 
| READ (MTAG213) IZIL 

‘ 213° FORMAT(AL) 

e IsTor a 0 

ISTRT # 1 

ms | IAITF @ 1h 


ANNAN Aan ONNA AANA ANAANAAAAANAAN 


IRITEN ® Ih 
ITPN @ 4h 


r @e@e UNCLASSIFIED ##e0 11/30/76 PAGE NO. O00 


c 
C 
(- 
c 
220 
221 
c 
c 
c 
c 
c 
c 
c 
C 
C 
c 
C 
222 
c 
c 
c 
233 
234 
223 
226 
. § 
‘ 227 
b 
® 
S 228 
fa 
}s 
bs 
': 229 
3 
* 
i. 230 
a 
225 
e 
; 226 


2a0e UNCLASSIFIED even 


11/30/76 PAGE NO. 000c 


IHSE = 0 16 


GO TO 220 


READ INPUT DATA 

CONTINUE 

Go TO (221 YeINTRN 
CONTINUE 


ANCET INPUT TAPE FORMAT 

IPOP IS BOPULATION PROJECTED TO 1974 

A IS SEMY MAJOR AXIS» MILES 

B IS SEM] MINOR AXISs MILES 

ALPH IS ANGLE Of ROTATION OF SEMI MAJOR AXIS DEGREES CLOCKWISe_ 
FROM THE NORTH 

TaR IS LAND AREA IN SQe MILES FROM cCOB 


READ (MTAs222) NAMAsNAMBeNAMCoITP9ISTs ICTY s+ IPLCoFLADeFLAMSFLASe 
l FLOOSFLOMSFLOS 2 

FORMAT(CAR gA2 o4XeT2o Al8X, 4XoA3,ASe TXo3FI.00F4,082F3520) 
6400 UNIQUE 

IF(EQF (MTA ) e&Gel) 2339234 

6400 RUN COMPILER BELOW,» FIN ABOVE 
IF(EQFeMTA ) 2335236 

CONTINUE 

IsToP 2 } 

ITPN 2 4HSTOP 

Go TO 240 

CONTINUE 

READ (MTAs223) IPOPs AvBsALPH» CRAD2sIAR 
FORMAT(I10e 10x 2eF5, ZFS. 1924x 9693191710) 
FLAO a» FLAD ¢ FLAM/60, ry FLAS /3600, 
FLOOD @ FLOD * FLOM/60° * FLOS/3600¢ 
IF (ITP enEez2) GO To 226 

ITPN = 4yU8 

Go TO 225 

CONTINUE 

IF (ITP eNE«e}1) GO TO 227 

ITPN = 4nhVG 

GO TO 225 

CONTINUE 

IF (ITP oNEe20) GO To 228 

ITPN @ 4HPB 

Go TO 225 

CONTINUE 

IF (ITP eNEe21) GO To 229 

ITPN = 4HLS 

Go TO 225 

CONTINUE 

IF (ITP «NEe30) GO To 230 

ITPN @ 4HRB 

GO TO 226 

CONTINUE 

ITPN @ GHHELP 

CONTINUE 

TAR 2 9 

crape = 0, 

CONTINUE 


U9 
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ae 


ig 
* 
t 
yx 
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24 
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ITPNN @ ITPN 
Ire (ISTRT e€Ge0) GO TO 237 


ISTRT a 0 
Go TO 23) 
237 CONTINUE 
Cc 
(= 
240 CONTINUE 
c WRITE OUTPUT TAPE 
Go TO (2x1 ) eo INTRN 


241 CONTINUE 
JRCOCT # yRCOCT * 1 
JUST Below 1S PROPER WRITE® CHANGED TQ SUPRESS 09S IN wRITE 
WRITE(MOT, 235) IBITFNeTTPCoITPN sURCUCTsISTNeICTYNe IPLCNONAMANG 
1 NAMBNeNAMCNe IPOPNeFLAONSFLOON® ANS BNe ALPHNe LARNe LHSENeCRADZN 
235 FORMAT, A) ASX 9ASeIS 9 1X pAZ AZ AG eI Xo 3ABe 19g PF Bebe 2F7, IF Tote 
1 169199F7,3) 
c THIS PUT IN TO SUPRESS Oe 
IF(ITPC e&Q- 4HRB » GO TO 262 
WRITE(MOT, 244) IBITFENeTITPCeITPN so URCOCTeISTNeICTYNe IPLCNONAMANG 
1 NAMBNoNAMCNO IPOPNoELADNSFLODN® ANS BN’ ALPHN® IHSEN 
244 = FORMAT( AleASe1LXeASe IS o1XeA2yA3gA% eo 1X9 3ABe IIe 2FGeS eC 7, IeF Tecy 
1 6Xel9e7x) 
Go TO 243 
242 CONTINUE 
WRITE(MOTe 345) IBITFNeITPCoITPN sURCOCT so ISTNeICTYNe IPLCNONAMANS 
1 NAMBNoNAMCNe ILPOPNeFLADNeFLODNe ITARN»s IHSENyCRAN2N 
2465 FORMAT ( Al gA4%olxsAS,ISo1xX9A2,A3eASe 1 Xp 3AGelIg2FBehe2lxy 
1 169I199F7,3) 
243 CONTINUE 
Cc OFBUG HERE) C20 CD COCCI OD COG ODd4 
IF (IBUGA .NEet) Go TO 1510 
WRITE(MQ 9235) IBITFNeITPCeITPN sURCOCTsISTNeICTYNe IPLCN®NAMANG 
1 NAMBNeNAMCNo IPCPNoFLADN sFLODN® ANOBNe ALPHNG I ARN» LHSENsCRANEN 
1510 CoNTINUE 
Cc OFBUG HEREQUOOQOOOOO0OQ00078 
IF(JRCDCT oGTe NTST) GO To 1500 
Ie (ISTOP .NFel) Go To 236 
ENOFILE MOT 


Non 


REWIND MOT 
Go TO 15n0 
236 CONTINUE 
c 
c 
231 CONTINUE 
Go TO ( 232 )sINTRN 


c NOW MOVE DATA FROM OLD BUFFER INTO NEW BUFFER 
232 CONTINUE 
IRITFN 2 IBITF 


IT?c = ITPN 
ISTN = IsT 
IcTYN = IcTY 
IPLCN # IPLC 
NaMAN # NAMA 
NaMBN & NAMB 
NaMCN @ NAMC 
IPOPN 2 POP 
FLAON @ FLAD 
FLOON # FLOOD 
AN @ A 

BN 38 


#e@e UNCLASSIFIED eeee ra 11/30/76 
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w 
oo 


aaNgananaaanananaaganananan 


268 


257 


#e®® UNCLASSIFIED ##e@ 11/30/76 
ALPHN = ALPH 
TaARN # [aR 
IHSEN = IHSE 
CRAD2N % cRA02 
Go TQ 221 


CONTINUE 
ECONOMIC DATA FROM CITY COUNTY DaTa BOOK 


Kc67=*= MEDIAN FAMILTY INCCME DOLLARS f4 

KC77ee TOTAL YEAR ROUND HOUSING UNITS? I7 

Kcl08== LOCAL GOVTe DIRECT GENERAL EXP. MILX 10% I5 
Kcl21 NO, MANUF, ESTes I5 

KC129"= VALUE AODED BY MANUFACTURE MILXloe le 
KC132"~© NOe OF RETAIL ESTAves 16 

KcC135e~< RETAIL SALESe THOUSANOSe 18 

KC138<=0 PERCENT RETAIL SALES THAT ARE FOOD SALES» 14 
KC160*" WHOLESALE SALES» THOUSANDS» Ia 

KC189 VALUE OF FARM SALES» THOUSANDS» 18 


IAITFN 7 1H 
ITPN ® 4HCEAA 
ITPNN = SHCEAA 


IpLc @ 4H 

JRcocT = 0 

CONTINUE 

READ(MTAs 2g2) ISTe ICTYeIMARK9KC679KC77 
FORMAT (A2,A3e 120113 yx 074017) 


6400 UNIQUE 

IF (EOF (Mra ) ,EG.1) 267,268 

6400 RUN COMPILER BELOWs FIN ABOVE 

IF(EQFsMTA ) 2679268 

CONTINUE 

BACKSPACE MOT 

ITPNN = GHSTOP 

Ist 2 ISTo 

IcTY = IcTYO 

KcC67 2@ Kc670 

Kc77 = KC770 

WRITE (MOT,262) IBITENeITPNGITPNNe JRCOCToISTsICTYeIPLc, 
1 KC67 9KC77 gKC109 9KC1 21 9KC 159 9 KC132 9KCT35 9 KC 138 KC 160 0KC 189 
ENDFILeE MOT 

REWIND MOT 

Go TO 1500 

CONTINUE 

Isto = IST 

IcTYO = IcTy 

KC670 @ KC67 

Kc770 ® KC77 

IF (IMARK .NEol) STOP 252 

IF (IST eNEGs 2HO2 eANDe IST eNE* 2H15) GO TO 257 
READ(MTAs243) IZIL 

READ (MTA0213) ITZIL 

REAO(MTAs213) 12IL 

Go To 25« 

CONTINUE 

IF (IST e€Qe 2436 eANDe ICTY oEQe 34905) GO TO 263 
IF (IST ef Qe CH3I6 eANDe ICTY o€Qe 3H047' =n TO 265 


eee UNCLASSIFIED eeee ~~ 11/30/76 
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ae 


™~ 


2s3 


263 


265 


266 


269 


246 


247 


248 


264 
254 


255 


@9@@ UNCLASSIFIED ##e0 11/30/76 PAGE NO. 000 
IF (IST e€Q. 2H36 eANDe ICTY .E@e 3HO8T) GO TO 266 
IF(IST eFQe 2H36 eANDe ICTY »EQe 3H08S) GO TO 269 
TF CIST eEQe 2451 eANDe ICTY eEQ@e 3HS15) GO TO 246 
IF (IST eF£Q. 2HS1 eANDe ICTY .EQe 3H595) GO TO 247 
IF CIST e€Ge 2HS) sANDe ICTY e&@e 3H775) GO TO 248 
READ(MTA,253)_IMARK,KC108,KC121 
FORMAT (SXq12032x 9759 40Xe15) 
IF (IMARK .NE.2) STOP 253 
Go TO 264 
CONTINUE 
Kclos 2 0 
Kcl2l 2 1748 
READ(MTA22]3) IZIL 
Go TO 264 
CONTINUE 
Kelo8 2 0 
Kcl2l = 6384 
REAO(MTA9213) IZIL 
Go TO 264 
CONTINUE 
Kclos = 0 
Kcl2l 3 2792 
READ(MTAg213) IZIL 
Go TO 266 
CONTINUE 
Kclo08 2 0 
Kel2] = 54 
READ(MTA0213) IZIL 
Go TO 26% 
CONTINUE 
Kcloa@ = 0 
Kcel2l = 60 
READ(MTAS213) IZIL 
Go TO 264 
CONTINUE 
Kcl0a8 = 0 
Kcl21 2 31 
READ (MTAe213) f2IL 
Go To 26% 
CONTINUE 
Kcl08 = 0 
Kcl2l = 37 
ReAO(MTAe213) IZIL 
Go To 64 
CONTINUE 
READ (MTA 254) IMARK eKC1299KC)329KC1359KC1 38 9KC1 60 
FORMAT (SX e129 lOX916.5KeTOe lho 1 4sG5xeT4) 
IF (IMARK .NE.3) STOP 254 
IFVIST e&Qe 2H29 sANDo ICTY oEQe 3HS513) GO TO 258 
IF (IST eF&Qe 2H24 sANDe ICTY e€Qe 3HS1%) GO TO 258 
REAO(MTAs ©55) IMARKs KCle9 
FORMAT (Sx ,12924X918) 
If (IMARK .NE&e4%) STOP 255 
Go TO 259 
CONTINUE 
Kc189 = 0 
READ(MTA0213) I[ZIL 
CONTINUF 


3 
- 


JRCOCT 3 URCOCT © 1 


~ 11730776 PAGE No. 0000 
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262 
Cc 


1811 


@e@@ UNCLASSIFIED #00 11/30/76 
WRITE (MOT,262) IBITFENeTTPNOITPNNe URCUCToISTeICTYeIPLC, 
1 KCO7eKCT/ 9KC108 0KC121 9 KC 159 9 KC132 9 KCT3S 49 KC13R9KC1609KC189 
FORMAT (Al pAb elXeASe Se lXeASeAZsASelxe 
1 149 7oleelSe2TenI8,l4eala) 
DEBUG HEREVD CDC COCO OOOO) 
IF (IBUGA .NEel) GO TO 1511 
WRITE(MG 9262) IBITENSITPNOTTPNNe JRCOCToISTsICTY IPL, 
1 KC67 oKCTT 9k C408 9kKC121 9KC129 9 KC1324KCT35yKC4389KC1600KC189 
CONT INuE 
DEBUG HEREQHOOOOOO0OQQ00 
IF (JRCOCT eGTe NIST) GO TO 1500 
Go To 256 


CONTINUE 
READ BLAST ANDO FALLOUT RISK DATA FROM aDaGIO INPUT TaPe 
PuT gLaSt RISK ON MOT ANO FALLOUT ON MTB 


IRITFEN ® 1H 

ITPB = 4HMRAA 

ITPBN & 4HMRAA 

ITPF @ GHCF 

ITPFN @ “HCE 

TPLC @ 4H 

®e*THESE WILL VARY wITH INPUT DATA 
1pOS1] = 2,50 

Tp0s2 
1p0s3 
Icosl 
tcos2 
JF ocT 
Jalct 
FLATM 
FLONM 
IPOPMU = V 


2H75 


CONTINUE 

READ(MTAsa72) ITPeLETNX 

FORMAT( A&éo127X¢ AS) 

6400 UNIQUE 

IF (EOF (MTA ) c&Ge1l) 2859286 

64600 RUN COMPILER BELOWs FIN aBOVE 

IF (EOF oMTA ) 2859286 

CONTINUE 

BaCKSPace MOT 

WRITE(MOT.281) IBITENeITPROITPBNOUBLCToISTeICTY »MCOCDeMNAMAD 
1 MNAMB eMNAMC eMUACING IPOPMUP IPOPMRe [PORMAsFLATMeFLONMOPSIMe 
2 ICLSMeIUACDSOISTMeYLOM 

BaCKSPACE MTB 

WRITE(MTQe 277) IBITFNOLTPFSTTPFNSJFOCT® ISTeICTYeIPLCe 
1 ((DCMOSE (CIX9 UX) 9 JXwl 93) oTXB1l 92) oICOSTs ICDSSs [PO0S1»IP0S2s IPOS3 
ENOFILE MOT 

ENOFILE MTB 

REWIND MOT 

REWIND MTB 

Go TO 1500 

CONTINUE 

CONTINUE 

IF (LETNX .€Q0¢4HCO » GO TO 27% 

IF(LETNX .EQe4HOBL ) GO TO 275 


eee UNCLASSIFIED e#ee == = -11/30/76 
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#e@@ UNCLASSIFIED *#e@ 11/30/76 PAGE NO. 004 
Go TO 273 ; 
c j 
274 CONTINUE 
c FaLLOUT RISK 
READ (MTAS27TE)ITPHISTHICTYs ( (DCMOSE (LXeJA) pdXB 103) 0TX@ 192) 9LETNX 
276 = FORMAT (Ab 9A2 9A3 04K 06F1064%95IX 95K 0 AG) 
JeOCT wz JFOCT ¢ 1 
WAITE(MTB® 277) IBITFNOITPFeITPFN®JFOCT® ISTeICTYsIPLCe 
1 ( (OCMOSE (IXe UX) 9UXele3) 2TABle2) 91COSIeICOSSs1POS1s1POS2sIP0S3 
277 = FORMAT(AL cASo1XeASeTSelXe AZeAS0A491X96F1000940X92Al 92x 93A2) 
c DEBUG HEREQCQVVQQOOOQQQQQ00Q08 
IF (IBUGA .NEel) GO TO 1512 
WRITE(MQ » 277) IBITFNeITPFoITPFN®JFOCT® ISTeoICTYsIPLC, 
1 (COCMOSE (1X9 UX) 9yXal 93) ofAB1 92) 9ICOSTsICOSSe1POS1s1POS291PpO0S3 
1512 CONTINUE 
é OFBUG HERECD CD CPC CPO COOP OO rE 
Ip (UFOCT eGTe ATST) GO To 1590 
Go To 2890 
c 
278 CONTINUE 
c BLAST RISK 
¢c 
c 
c IPOPMU URBAN MCO POP 
c IpOPMRe= RURAL MCD POP 
c TPOPMas* URBANIZED aREad MCD POP 
(2 IPOPMT== TOTAL CD POP 
Cc MUACIN©® CODE OF Ueae MCD IS LOCATED IN® IF BLANK NO Une 
c PSIM== HIGHEST OVERPRESSURE oPSI 
c OTSTM== DISTANCE FROM WEAPON GIVING HIGHEST OVERPRESSURE*Mre 
c YLOM*= Yrelp OF WEAPON GIVING HIGHEST OVERPRESSURE® MT. 
c IclLSMe2 @LUSTER NUMBER CONTAINING WEAPON GIVING HIGHEST OVP. 
c IUACO*= CODE OF Used WITH CLUSTER FOR HIGHEST OVERPRESSURE 
c IF NONE CODE IS BLANKS 
(= 
READ(MTAe279) ITPsISToICTY »MCDOCDeMNAMGeMNAMB sMNAMCOYLOMeIUACDy 
1_ TCLSMs SSIM*® DISTMseMUACIN® IPOPMAs yPOPMT sLETNAX 
279 = FORMAT (AG, A2,A3,A4, SAB LIX 92K oF 45092 0A4,2x9AG,2FR,3, 
1 2X9AGe2Xel7916Xel8el0Xehe) 
c 
c IF NO SEPERATE URBAN AND RURAL POP GIYEN PUT aLL INTO RURAL 
IPOPMR 2 [POPMT © TPOPMA 
JALCT = JBLCT « 1 
WRITE (MOTe2Q—1) IBITENSTTPReITPENeUALCToISTeICTY eMCOCD eMNAMA® 
1 MNAMB oMN AMC PMUACTNe IPOPMU 9 TPOPMR® TPORMAoPLATMOFLONM9PS IMG 
2 1CLSM,1Uacp,Or1STM,yLoM 
281 FORMAT ( Ay pAGojXeAbeISe1Xe A20A39AGo 1X0 3A8 9A4 e317 9 2F8, 3% 
1 FT e2elXoASelXo4oFb02066,9) 
( OFBUG HEREQHOOOOOOOOOO OQ) 
Te (IBUGA .NEel) GO TO 1513 
WRITE(MG 4281) IBITENs ITPReITPBNy JBLCT,ISTs ICTY »MCOCDyMNAMAY 
1 MNAMB9MNAMC9MUACTNe IPOPMU9 TPOPMR® [PORPMASFLATMPFLONMIPSI Me 
2 ICLSMeIUACD*SOISTMeYLOM 
1513. CONTINUE 
c DEBUG HEREQHOOOOOOOOO0 0074 
Go To 280 
Cc 
Cc 
¢C 
c To INTRODUCE MEOLIST RECOROS 
@e@@ UNCLASSIFIED *##@ =~ 11/30/76 PAGE NO. 0000 


#e*@ UNCLASSIFIED #08 11/30/76 PAGE NO. 000¢ 

CONTINUE 

CatlL NOPCHKE (0) ye 

NTST ® 400 

NTST = 999999 

JRCOCT = 0 

ISTOP = 0 

ISTRT #8 0 

Ir8 = lh 

NTPA = 4HGBBA 

NTPg = 4HGBBB 

NNTPA 3 NTPA 

NNTPB ® NTPB 

Nc 2 0 

WRITE (MQ9303) 

FORMAT(/////s10X9*LIST OF URBANIZED AREA CODES AND ASScCIATED CODES 
1 FOR PRIME COUNTY FOR FUTURE FIPS ORDERING® »///9# NO, STCNT UAC 
20 NAME*e/) 

CONTINUE 
NC = NC # } 

READ (MP 9305) ICTeISTCOsIUAsNAMEA »NAMEH pNAMEC 

FORMAT(I1%, 1x9A5e1X,A%e5X92A8) 

ISPFST(NC) w YSTCO 

ISPLST(NC) = IUA 

WRITE(MGe304) ICT» STCO» IUAs NAMEASNAMEBONAMEC 
FORMAT(LH 9 [4e1XeASe 1xX9A%—_ 5X93A8) 

IF(IUA eNE» %H9320) GO TO 302 

CONTINUE 

READ(MTAs 3091) ISTCDeICOCO*ICNCTs MCDCNsIPLCDeIPLOEC#ICOSMyIUACDs 
1 TCBOCO*NAMEA*NAMEBeNAMECe LCDTCT s IcpBLGe LEOCOs URC» IHSEs [POPs 

TLONsILAT 

FORMAT (A2 2x eA2eIXeAle ADsA4 Ale 3XeA%e A4e1SXeAl es 3A8e6XnAbe 
1 A1,AS 941 ,4X917 418,110,110) 

IF (EOF (MTA) 2EQ.1) 3119312 
CONTINUE 

ISTOP 2 j 
CONTINUE 

IcNT 2 ICNT @ } 

IF(ICNT .GTe NTST) STOP = 1 

IF (ISTRT .NEo%) GO TO 313 

IsTRt = 1 

Go TO 315 
CONTINUE 
IF (ISTOP .NEel) GO TO 316 
NTPA 2 4HSTOP 
NTPB @ 4HSTOP 
CONTINUE 

IF ( JUACD s&Qe 4H ) GO TO 317 

IcOWT = JUACD 
Go To 319 
CONTINUE 

IF(JPLCD .EQe 4 ) GC TO 318 

IcoO¥T ® JPLCO 
Go To 319 
CONTINUE 

IcOwT @ 4H 
CONTINUE 
JRCOCT ® YRCOCT * 1 

IF (URCOCT 0€06100000) uRcOCT = 0 
WRITE (MOT, 321) IFB, NNTPA®NTPAs JRCDET » JSTCDsJCOCDs ICDWT» 
1 JPOP sJHSE»y FLATeFLON® JCUTCT® JCOBLG»JEDCD 
FORMAT( Alo AS elXeASoTSeolXe AZHASeAGotve 180179 CFB .4eAGglXeAls 


#ee@ UNCLASSIFIED ##@@ ~~ = 11/30/76 PAGE NOw ovo 


| 322 
315 
| 326 
327 
328 
329 
325 


aananna 


#e@ UNCLASSIFIED #000 11/30/76 PAGE NO, 00U 


1 1%9AS) 
WRITE(MTB, 322) IFB, NNTPBONTPBs JRCOCT » JSTCDeJCOCDs ICOWT,s 
1 JAMEAsJAMEBOJAMECe JMCOCD® JPLCD» UPLDECs JCDSM*JCNCTsJCBOCD,s 
2 JYURCDsJCOTCT » JCOBLGs JEDCD » JHSE, JPOP ,PLAT,FLON ,JCNCD 

FORMAT( Al® ASP XsAgeT5e1xX9 A2VAZASHTX? JABVLAVAZ* LX PAGe]XeAL OL 
UX eASelXoALOIXPALelLXgAlelXeAGolXoAlelXeAS eel e2FBe4e1XeAS) 
IF(ISTOP .€%.1) GO TO 325 

CONTINUE 

ENCODE (593269JSTCO) rSTCOrICOcD 

FORMAT (A2,A3) 

Do 327 I = enc 

Imp (ISPLST(1) e&G@e IUACD) GO To 328 

CONTINUE 

JCNCO = 5H99999 

Go TO 329 

CONTINUE 

JCNCD = ISPFST(I) 

CONTINUE 

JsTco =» IsTco 

JcOcd 2 Ic0cod 

JeNCT = ICNCT 

JMcOCD = mMcoCcOd 

JPLco = IPLcD 

JPLOEC # IPLOEC 

JeOSM = IcoSM 

JUACD # TUACO 

Yesoco 2 Ica0co 

JAMEA = NaMEA 

JaMEB @ NAMEB 

JaMEC = NAMEC 

vcOTcT ® IcoTcT 

JcOulLG 2 IcpBLG 

YeOcd = IepDcO 

JuRCO 2 rURCO 


JHSE # IKSE 

JPOP = IPOP 

JLAT @ ILAT 

JLON # ILON 

FLAT = JLaT 

FLON 3 J) ON 

FLAT = F; aT/10000, 
FLON @ F, ON/10000, 
60 To 3lo 

CONTINUE 


ENOFILE MOT 
ENOFILE MOT 
ENOFILE MTB 
ENOFILE mTg 
Re TURN 


CONTINUE 

Re TURN 

ENO 

SUBROUTINE EXTRCT 


THIS SECTION TO EXTRACT FROM FILES 
IT IS TO RE WRITTEN 


#e@@ UNCLASSIFIED ###6 j 11730776 PAGE NOw nnve 


tee | 


aaa 


no aoa 


eaee UNCLASSIFIED ##00 11/30/76 PAGE NO, 00006 


COMMON / CONS/ [8UGasIBUGR® 1BUGC® 1 BUG» IQGUGE» IBUGF s 1BUGG»s IBUGH iad 
1 9 MSKAR(10)9 MSKAsMSKBeMSKCeMSKDe MSKEeMSKF » MPsMQ9MSoMOTOMOP 
2 MRD(10) eM! AeMTBeMTCoMTD oMTE MTF oMTGoMTHgMTI oMTU 

3 »MXWROONTSTPPNCHRW »MXSPRU 

COMMON /MISC/ KNXDA(15) 9 MNXDA(15) 6 NNXDA(15)¢ ICNTeNTSTsISTOP 
le yRCOCT 


Az) 


RETURN 
END 
SUBROUTINE ORDER 


COMMON / CONS/ [BUGaslB8UGB 9 IBUGC® I[gUGOsIQUGEs 1BUGF » IBUGG»s IQUGH 

1 9 MSKAR(10) 0 “SKA yMSKGeMSKCeMSKD® MSKEeMSKEs MP eMQeMSeMOT + MOP, 
2 MRD(10) oMTAs@TAsMTCeMTDeMTE MTF MT Ge4THeMTI MTU 

3 sMXWRO®NTSTPSNCHRW »MXSPRU 

COMMON /MISC/ KNXDA(15) ¢ MNXDA(15) 9 NNXDA(15) 0 ICNTeNTST*#ISTOP 
leyRcocT 


Re TURN 
End 


oe@e UNCLASSIFIED #ee. 11/30/76 PAGE NO, 0000 


SaANNNAANAANLANANAKCAAAAN 


aooca 


acon 


Jol 


ea%e iINCLASSIF7FN seee 12/14/76 PAGE NO, 00% 
SUBROUTINE EVIT 33 


BEGIN EDITING SECTION @eeoteeeeoce 


Coeteegere 
Secece se See eS eee@eeeg® 


EDITING IS CUNTROLLED BY INPUT EDIT FILE EITHER INDIVINUALLY 

OR WITH COMMUN FOR AN ENTIRE STATE( DEFINED BY FIRST 2 CHARACTERS 
OF FIRST FIPS ecDE), INPUT INTO A READ BUFFER Me CONTROL OF 
OEFINEO SY JSPLST(L)« AFTER TNPUTING A RECORD SEARCH CORRECTION 
FILE FOR CORKECTIONSe ADVANCE TO N BUFFER RFADY TO WRITE EXCEPT 
FOR NEXT RECURN Tyee. ANVANCF TO K BUFFER TO WRITE AFTER PUTTTING 
CURRENT RECORU TYPE IN N BUFFERe WRITE FROM K BUFFER WHEN INPUT 
OR INSERTS PUSH FROM N BUFFER, 


DIMENSION ICOMNA(29,10) »ICOMFS (20) ,ICOMLS (27) ,ICOMTP (40; 

DIMENSION ISTLST(5n) 9ISTTP (Sn) ep LPLLST(100) sIPLTP (ino) eIPLFLG(1900) 

COMMON / FILUR/ NM&GA(10) 9 NTYPA(10010) » NOROIT (200) NORLVII100)» 
1 NtypIJ(100)¢ NUNKL (10910) 9 “NESCx(100 94) » NCHRA(1O01U)» 

2 NCHRCU (100) sNMRGTONTYPT 

COMMON / ENRUPY JFRCU(100) »URECTP(100) 5 JNXTP(100)5 URCTCU(L0O0)» 

1 JCyFpA(100)» JCUF SB (100) sJSpNFA (300) »s USPNF3 (300) sUSpNRT (300) >» 

2 JSPXTA(600)e TCF(1N0) 

39 JFBNX(100)e JNFCUR (100) »INFNXT(100) 9 JRCTNX(100) 6 JNAFPA(100) » 
& JNAFpB(100) eUNxTDA(100015) e TNF (100) 

COMMON /SPBUF/ JFBSP(300)»s JSPCUR(300), JNFSP (300) sURCTSP(300), 
1 JSPFPA(300)e JSPFPR(300) 9 JSPDA( 200915) eNSONUs 
2 ISpPFST(300)e TEPLST(300) » JIspFST(300)» JSpLST (300) 

COMMON / CONS, 18U94,18UG8,IRUGC,IBUGD,IBUGF,IBUGF ,IBUGG,14UGH 
1» MSKAR(10)¢ MSK4 MSKBoMSKC yMSKOy MSKE»MSKF» MPyMQyMSeMUT 9MOPy 
2 MRD(10) eMTAOMTREMTCOMTD OMTE oMTF oMTGoMTHoMTT oMTJ 
> sMXWROQNTSTPeMCHRW »MXSPRU 

COMMON /MISC/ KAXOA(15) 9 MNXNaA( le)» NNXOA(1e)» ICNToNTST9iSTOP 
ly» URCOCT 


INITIAL TZE 
NTST 3s 9999999 
yooc 
Jnon 
JOOF 
JDOG 
NIST 2 
MBUFFL 
NBUFFL 
KAUFFL 
00 2 L = 19100 
JNBFPA(L) = 5499999 
JNBFPBI(L) = #49999 
CONTINUF 


a 


yu 
wuunrrre 


m-oo°o 


WRITE (MN,301) 
FORMAT S// ae BnNXe* cece toes EDITING OF TNPIUIT FILE Sacccese*t///) 


nn 


eeee NCLASSIFIFD e#e- 12/14/76 PAGE NO, 


315 
312 


307 


FE I re 
ee 


999 
908 


bee 


ool 


ee? (NCLASSIFT EN o#e* 12/14/76 
READ(MP,311) NiTyPT,ISC,IPEOT oF 
FORMAT(/95110) 

Read ORDER FUR IASERTENG 

00 315 ft = LeNTYPT 

READ (MPe316) LelTaslTBelTCeltosITEsITF 
FORMAT ( 1393X04491595X94A10) 

NTYPIU(L) 2 ITA 

NCHRCU(L) = ITR 

MnESCR (101) a 1TC. 

MOESCRiLeo) # 1TO 

MOESCR(L»3) = TTe 

MDESCRI(Lo4) @ TTF 

CONTINUF 

WRITE (Myo 312) 

FORMAT( //#1M0,*ASSUMED RECOKD ORDER ON FILE TO EDIT 1S AS FOLLOWS 

1 #9/9® NOe TYPE NO CHAR, DESCRIPTIANG®9/) 

Oo 313 L = lenryPT 

WRITE (MQ0314) Lo NTYPIJ(L) sNCHRCU(L) » (MDESCRi Lol) 9Iel 94) 
FORMAT(1H 9 14 92X%9A499X01692x44A10) 

CONyINUF 


READ COMMON CHANGE ITEMS 

ICOMNU = 0 

CONTINUE 

ICOMNU = ITCOMNI) * 1 

READ (MP,397) LCOMFS(ICOMNU) 9 TCOMLS (ICOMNU) » (ICOMDA(TCOMNUSLL) » 
LL = 467) 

FORMAT (139 2X01 992X07Al0) 

IF CICOMFS(ICUMNU) .£92999) GN TO 903 

IF(ICOMNU eNE«t) GO TO 904 

WRITE (MQ09y5) 

FORMAT(1HO50X,#DEFINITION OF COMMON CHANGE TYPES#,/, 

1 # NOe START LAst INSERT TEXT®9/ ) 

CONTINUF 

WRITE (M9906) TCOMNUSICOMFS(TCOMNU) » ICOMLS (TCOMNU) 5 (ICOMDA(ICOMNUs 
LL)eLL 2 1°97) 

FORMAT(1H sIlaesl604x97Al10) 

GO TO 3n6 

CONT INUF 

ICOMNU = TCOMNI! = 1 


REAQD STATE EUVITING ITEMS 

NST = 0 

CONTINUF 

READ (MP,319) 1TAgITS 

FORMAT ( Ao* oXeT2) 

IF(ITA ,Eqe 2499 ) Go Tq 320 

ITA = ITA eAND, MSKE 

NST 2 NST * y 

IF(NST ,NEo] ofRe IPEDT eNEoy) GO TO 98 

WRITE (MN99V9) 

FORMAT (//9IHOe20Xe@LIST OF COMMON STATE EDITING ITEMS#s//) 
CONyINUE 

ISTLSTI(NST) # TTA 

ISTTP(NST) ® Ifo 

IF(TPEOT +NEez) GO TO 

MBITETMOvaao) USTs [STLSTINST) sISTTP INST) 

FORMAT(1HO» ® FOR & [35 # TH ITEM FOR ALL RECORDS WITH STATE NUM ' 
1BER #, A2 o@ TAKE ACTION NUMRFR*,13) 
CONT INUF 

Go TO 318 


ae 


ea®e UNCLASSIFIED #eee 12714776 PAGE NO, 000 


st 


yl 
91 


365 


San 


326 


eave UNCLASSIFIEN #¢e8 12/14/76 PAGE NO, 99 
CONTINUF 3 


READ PLACE EVITING ITEMS 

Nel = 0 

MSKG @ 777777779000000000008 

CONTINUF ; 

READ(MP.912) ITASITASITC 

FORMAT (Agel oeI5) 

IFCITA .EqQe 449999) Go To 913 

ITA , ITA eAND, MSKG 

NPL = NPL ® } 

IF (NPL .NEo} eRe TPEDT eNEoy) GO TO 914 

WRITE (M099)5) 

FORMAT (//91HUe?0Xe*LIST OF COMMON PLace EDITING ITEMS#,//) 
Conti que 

TPLLSY (NPL) @ TTA 

IPLTP(NPL) = ITR 

IPLFLG(NPL) 3 77C 

IF(IPEOY ,NE«1) GO TO 916 

WRITE (M9917) NPLe IPLLST(NPL) o LPLTP (NPL) oe LOLFLGINPL) 
FORMAT(1HOs ® FOR oe [39 * TH ITEM FOR ALL RECORDS WITH PLACE NUM 
1BER @, AG 9* TAKE ACTION NUMRER®9139® wITH REPEAT FLAG 2#912) 
CONT INUF 

Go TO 911 

CONTINUE 


READ INNIVIDUAL EOLTTING ITEMS 

NSPNU 2 0 

CONTINUE 

READ (MP 4322) MERNX eMNFCUR »MNENXT oMRCTNX sMNBEPA SMNBFPB 
LOMNXDA(T) 9 l= Le) eI TA 

FoRMAT(AL SAG 1x sAbeTS0lXeASe Abel x e5A10,A4) 

IF (MNFCUR e&W. 4HSTOP } GO Ta 324 

NSPNU = NSPNU « 1 

IF(NSPNU 4LE*s 390) GO TO 889 

WRITE (MO 885) MNFCUR® MNBFP A 

FORMAT(1HO09® TAN MANY INPUT CORRECTIONS AT RECORD TYPE *®eAue 
1 # AND CODE %eASe See"Srope-ee) 

STOP 3259 

CONTINUF 

IF (IPEOY ,NEel) SO TO 883 

IF (NSPNtH wNEe 1) GO TO 883 

WRITE (MQ9884) 

FORMAT(///9140o® oe. LIST OF INOIVIOUAL EDIT CHANGES .oe%9///) 
Conti Que 

READ (MP4323) ITRy(YNXDA;T) »l#7,11) eIFLG ,ITC,ITO,ITE 
FORMAT( AGeSALA 8 Xel3e 1XsASeAGe1X9A4) 

ENCODE! 109325e¥NXD4A(6)) ITAeITB 

FoRMAT (44,A6) 

JPASP (NSPNU) 3 MPBNX 

JSPCURINSPNU) = MNFCUR 

JNFSP(NSPNU) & MNENYXT 

JRCTSPI(NSPNU) = MRCTNX 

JSPFPAINSPNU) = MNQFPA 

JSPFPRBINSPNU) a» MNAFPS 

00 326 LL = 1978 

JSPHAINSPNUsLL) = MNXDA(LL) 

CONTINUE 

JSPLSTI(NSPNU) = IFLG 

JSPNFA(NSPNU) = ITC 

JSPNFQ(NSPENU) @ ITS 


eete jw CLAggIFTED e#o% 12/14/76 PAGE no, 0° 


ae*e \INCLASSIFIFD ##9? 12/14/76 
JSPNRT(NSPNU) « ITE 
00 329 LL = leNnTYPT 
TE (MNF CUR SEQeNTYPTUILL)) GO Tn 992 
329 Cont lyuF 
ISPLSTINSPNU) = 99 
WRITE (MQ9895) NSPNUsMNFCURSMNAFPA 
895 FORMAT‘1HO 0%,eAT INPUT NO ®e139® RECORD TYPE *eage @ WITH CODE * 
1 »ASe # Ig INYALIDN TYpE®) 
Go TO 893 
392 CONTINUE 
ISPLST(NSPNU) » LL 
893 CONTINUE . 
IF(IPEOT eNEe 13 GO TO 327 
WRITE(MQe89AR) TFELGeTTEPITCeI Tp 
398 FORMAT(1HOe® acTION TYPE®sI13.@ AUAILARY RECORD TYPE aNO COVE ARE * 
1 9 4493y0ASeAs) 
WRITE(MQ » 328) MFBNX »MNFCUR,MNFNATeMRCTNX,“NBFPA,MNBFRB, 
1 (MNXDA(LL) eLLw 1911) 
328 FORMAT(IH sAleAdelxeASelISy 1x eASeA4elke10A10,49) 
327 CONTINUF 
Go TO 321 


324 = CONTINUF 

Cc 

Cc 

c 

c TaA0J = INDICATES NO INTERFRRENCE WITH SEGIIENCEs NEXT RECORD 
Cc TYPE Ocskes If1 MUST BE ADJUSTED BEFORE WRITE 

Cc JSPLST(L) IS acTION TYPE 

Cc JSPFST(L) IF ONE THIS CORRECTION HAS BEEN USED 

Cc IsPFST(L) = 1 INSERT AFTER NEXT WRITE(N BUFFER) 

c ISPFST(L) = 2 INSERT AFTER Two WRITES (AFTE2 M BUFFER WRITE) 
Cc ISPLST(L) PLacr OF RECORD IN LIST 

c M BUFFER JUST READ MATA 

Cc N BUFFER REAUY TO WRITE EXCEPT FOR NEXR FIPS CODE 

Cc K BUFFER WRITE FROM HERE 

c 

(e 

Cc 

339  CONTINUF 


IF (MBUFEL «&Me7)GO TO 350 
ICNT 3 TCNT @ y 
IF(ICNT «GT. NTST) RETURN 
READ (MTA 933)) MPRNXeMNFCUR sMNFNXT eMRCTNX eMNBFPA SMNBFPR 9 
1 (MNXOA(LL) eLL = 1eMXWRD) 
331 FoRMAT (AL Abel x gAbeTSelxeASeAaeglxsllAlo) 
Cc 6400 UNTQUE 
IF (EOF (MTA )6E&Q,1) 3339332 
c 6499 RUN COMPILER BELOW, FIN sROVE 
Cc IF (EOF euTA ) 333933? 
333 CONTINUE 
c ENO OF FILE 
IsTOP 2 1 
MBUFFL = 9 
Go TO 360 
332 CONTINUF 
c NO END OF FILE 
MBUFFL # 1 
Cc 64on UNTQUE 
(> THIS IS TO CUNVERT ALANK#] To 991 
IyM = MNRBFPA 4AnO, “SKC 
IF (ITM .NEe MSkA) GO TO 334 


eefe UNCLASSIFIED s@ee 12/14/74 PAGE NO, 000 


‘ 


334 


bo7 


923 


336 


688 


ae@e UNCLASSIFIED ##e% 12/14/76 
MNBFPA = Msks .CR, (MNBFPA ,AND, MoKA) 
CONTINUF ‘ 


IF(NSTe EQe 0) GO TO 338 

S400 UNTQUE 

ITMP 2 MNOFRPA ,AND, MSKE 

DO 339 T = }9NST 

IF(ISTLST(1) «NEeITMP) GO TO 439 
IF(ISTTP(I) eNE, 1) GO TO 887 
MBUFFL #& g 

Go TO 330 

CoNTINUF 

IF(ISTTP(L) eLE, 17) GO TO AAb 
Jn0G = yOOG * j 

TcOMTP(y00G) = ISTTP(I) = yo 
CoNTINUF 

OTHER ACTIONS nc NOT MAKE SENSE FOR A WHOLE STATE 
CONTINUF 

CoNTINUF 


IF (NPL ,EQ,0) GO TO 920 

6400 UNTQUE 

ITMP a2 MNBFPB .ANDe MSKG 

0O 927 T = 1 eNPL 

IE (IPLLST(I) eN&e ITMP) GO TN 921 
IF (IpLFLG(I) .Fae2) So To 92) 
ONLY DO ONCE IF PLACE FLAG IS 9 
IF(IPLFLG(L) eFGen) IPLFLG(I) 2 2 
IF(IPLTP(I) eNF,1) GO TO 923 
MBUFFL = 0 

Go TO 330 

CoNTINUF 

IF(IPLTO(Y) eLF, 19) GO TO 924 
JnOG = yOOG ¢ |} 

TCOMTP(YDOG) = JPLTP(I) © 1o 
CONTINUF 

CoNTINUF 

CONTINUF 


SEARCH SPECIAL ENITING INSTRUCTIONS 
IF (MSPNU gEQe0) GO TO 343 
00 235 L = 1eNSPNU 
Ip (USPFST(L) eFGel) GO TO 336 
IF (USpFDA(L) wNFEeMNRF RPA) GO tO 335 
IF(TSC ,EQe1) GO TO 336 
IF (USPFEB(L) eNFe MNSFPB) GO TO 335 
CONTINUE 
TF (USPCUR(L) eNF&e MNFCUR) GO TO 335 
IF (USPLST(L) »NFey) GO TO Baa 
JSPFST(L) = y 


4006 3 f 
MBUFFL = 9 
Go TO 330 
CONTINUE 
IF(USPLST(L) oNFed) GO TO 889 
JDOD = DOV ¢ 7 
JSPFST(L) = 1 
IsPFST(i.) = 2 
JSPFPA(L) = JSOAFA(L) 
JSPFPRIL) = JSPAFRIL) 
JSPCUR(Y) = JSPART(L) 
weve \NCLASGIFTED S#@- ~~ 12/14/76 


PaGE NO, 094 


PAGE NO, 0: 


B69 


390 


B94 


896 


342 


#e*® UNCLASSIF ren **e® 12/14/75 
Go TO 335 Ho 
CONTINUF 

IF (USPLST(L) eNEeS) GO TO 899 

JSPFST(L) 3} 

NrST a NIST ¢ 7 


ISPFST(L) 2 y 
JSPFPA(L) 2 USPRFA(L) 
JSPFPA(L) # USENFBIL? 
JSPCUR(L) = USPNRT(L) 
GO TO 335 

CONTINUF 


IF (USPLST(L) eNF,6) GO TO 896 
CONVERT MOVE To INSERT ORDER 
JSPFSTI(L) 3 0 


JSPLST(LI = 2 

JgpFpA(L) = JsphFA(L) 
JSPFPRI(L) = USPRFBI(L) 
JSPCURI(L) = YSPEARTI(L) 


JFBSP(L) 2 MPONX 

JNFSP(L) = MNENXT 

OO A94 LL = jeje 

JSPNA(LeoLL) & MNXDA(LL) 
CONTINUE 

MBUFFL = 9 

GO TO 336 

CONTINUE 

IF(USPLST(L) eLEeln) GO TO 891 
JSPFST(L) 2 1 

JO00G = JDOG * 75 

ICOMTP(JOOG) = YSPLSTI(L) = 14 
Gn TO 325 

CoNTINUF 

IF (JSPLST(L) oFGe3) J0OC aL 
CONTINUE 

CoNTINUF 


FIND PLACE OF THIS RECORD TyprF 

DO 3461; LL = loNTYPT 

TE (MNFCUR eN&e ATYPIJ(LL)) Gn TO 341 
LLINM 2 LL 

GO TO 8a7 

CONTINUF 

CONTINUE 


LoOK FOR INSERTS 

IF (NSPNIY ,EQeu) GO TO 344 

00 337 & 2 1 eNSPNU 

IF (USPLST(L) eNge 2) GO TO 397 

IF (JspFet( ky) .Fqel) GO 70 333 

IF (JSPFPA(L) oGTe “NBFPA) GO 10 337 
IF (USPFPA(L) sLT* MNBFPA) GO TO 345 
IF(ISC .EQe7) GO TO 340 

IF (USPFPB(L) «GTe MNBFPB) GO TO 337 
IF(JSPFEB(L) «LTe MNBFPB) GO TO 340 
CONTINUF 

NOW CHECK RECUPD ORDER 

IF (ISPLET(L) eGTe LLINM) GO TO 337 
CONTINUE 

NIST # NIST ¢ 1 

ISPFST(,) = y 

JSPFST(L) = } 


este WNCLASSIFIFD ##0@ ~~~ 12/14/76 PAGE No. 000" 
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337 CONTINUF fe 
344 CONTINUF 
| c 
} Cc 
c 
350 CONTINUF 
c Now INTERPET ACTION 
(é MAKE CHANGES 


IF(UO0C .£8.0) GO To 351 
MFBNX # JFBSP(J00C) 
MNFCUR = JSPCUR(/DOC) 
MNFNXT @ JNFSP( DOC) 
MRCTNX =» JRCTSP(Y09C) 

s 

a 


MNBFPA JSPPRP,(JDOC) 

MNAFPB JSPFPR(00c) 

00 352 LL = 1915 

MNXMNA(LL) = JOPCA(JDOCeLL) 
382 CONTINUE 


Jo00C = A 
351  CONTINUF 
c 
IF (J00G .EQe 4) GO TO 353 
c IF THE TYPE 1S GREATER THAN 29 THE USER MUST INSERT SPECIAL CONE 
C TO MAKE THE UeSTREN TYPE OF CHANGES 


Do 109091 K = 1eyn0G 
IT = [COMTP(K) 
IF (IT .GTe 1y) GO TO 1059 
IF (IT eLEs TCOMAUIGO TO 1992 
WRITE (MQs7Q93) MNFNXT® MNBFPAsMNBFPBs IT 
1003 FORMAT(THOs ®~eeTROUIBLE AT RECORD TYPE *e4ge% AND CODE *9A5%A49* 
1 FOR CHANGE TYPF Ig *9149@ WHICH Ig MORE THAN INPUT NO,®) 
STOP 10n2 
lees CONTINUF 
ITF = ICOMFS(IT) 
ItL = IcOMLS(IT) 
IWwOF = (ITF = 7)/NCHRW © 1 
ITa 3 ITF *(iwne = 1) *NCHRW 
ITSHE Z(NCHRW « Lo ITA % 
IcHF 3 (IwOF = 1) @NCHRW « 1 
JwOF = TWOF 
JwODA 2 } 
JDACT = 1 
vFCT 2 1 
loos CONTINUF 
IAR = NCHRW @ 1 © JFCT 
IF (ICHF «GE, ITFe 4NOe ICHF LE. ITL) GO TO 1906 
JWwOCN 2 (MNXDA(QWOF) eAND,. MSKAR(IAR)) OR. (JWOCN,AND..NOTeMSKAR 
y (TAR)) 
GO TO lalg 
109% CONTINUF 
IARDA = NCHRW « 1 © JOACT 
TTMP = TCOMDA(JWODA) eANDe MSKAR(TARDA) 
c SHIFT(AsB) IS A 64 ROUTINE WHICH SHIFTS a LEFT CIRCULARLY 8 BITS 
c CIRCULAP SHIFT 1S Sosentrat HERE 
ITM = SHIFT (TTMPyITSHF) 
JWOCN 2 (TTM eatODe MSKAR(TARY) .ORe (UWDCNe ANDeeNOT.MSKAR(IAR) ) 
JNACT = JOACT « } 
IF (JOaCT eLEe NCHRW) GO TO in19 
JOACT = } 
JWONA = JwONA + } 
lola CONTINUE 


ee%e IINCLASSIFIFN o@**? ; 12/14/76 Pace NO, 90 


-- a - - - — 


~ oe Pa - . . po eo wee 


wry, on 


aeee UNCLASSIF TEN #te# 12/14/76 
Ce#eeQUG STaARTeeeeeenn 
IF (tguGC ,NEe1) GO TO 901 
WRITE (Mn e902) LrPelrbLelwOF sl ysHF »JWwOF euwODAs JDACTeIFCT, 
1 TAReTARDAe ICqMDA(JWDDA) pI TMPgITMeJWOCN»e ICHF eJRCDCT 
902 FORMAT( 1H ¢® RUG CONSTRUCTING®s lLOIge AlCe 3A109 214) 
901 CONT INUF 
C##eee@eRUG ENDe*eeene 
JFcT = JFCT © j 
ICHF = ICHF « } 
IF(JFCT eLE. NCKRW) GO TO longs 
JFCT a y 
MNXNA(JWOF) # JWOCN 
JwOF = JWOF ¢ 7 
IF( IcHF ,LE. TL) GO TO 1995 
CONTINUF 


CONTINUE 


USER INSERT SPFCIAL COOE HERE FOR UNIQUE COMMON CHANGES 
STATEMENT NUMBERS FROM 1051 To 1099 MAY BE USED 


JN0G sn 
CONTINUF 


360 CONTINUF 
Cc WRITE RECORD FROM K BUFFER 
C#*#neBUGG START S*eeenataen 
IF (1TBUGA ,NEe 1) GO TO 376 
WalTE (Mae 377) KBUFFLeNOUFFL.«MAUFFL NIST #J0OCsJ000, DOF » JD0GsLU 
377 FORMAT(1HOs ® RUGGe=w Ae= K N Mm BF FLoNIST JNO C DF GLU 249914» 
1/4 9# CONT OF KoeNeM SUF 3) 
WRITE (Mao 388) KFBNX Ky CUR DK AFA XT eKRCT YX 9 KyBF pA s Ky BF pBy 
1 (KNXDA(LL) ,LLa 1,11 ) 
FORMAT (1H 981 0A4%1X%9AG9T591X0A59AG01X910A199A9) 
WRITE (MO9 308) NFANX eNNF CUR eNNENXT #NRCTNX #NNBFPASNNBFPB » 
1 (NNXDA(LL) olLLs 1591) ) 
WRITE (MQ 9388) MERNX eMNF CUR» MNENXT pMRCTNX »MNBFPA oMNBFPB 9 
1 (MNXDA(LL) sLtLs 1ell 
WRITE (MQ 9389) LLL yk ebb I yell tym 
FORMAT(1H 9® LLINKeLLINN©e LLINM = #9378) 
00 378 LL = lensPNU 
WRITE(MQ9 379) Lie IspFST(LL) ef splLsSTI(Ll) eJspFET(Lh) sUspLSTILl) » 
1 JSPCUR(LL) sJSPFPAI(LL) sUSPFPRILL) »JSPNFA(LL) sJSPNFRB (LL) eJSPNRT (LL 
) 
379 FORMAT (YH 9* La®el3e% I JY Sp FST LST = #94169 TYPE FIPS SPEC=#» 
1 2X0 AGelXoASeAge2Xs ASvAGel XAG) 
378 ContTIQur 
376 CONTINUE 
C##ee#8BUG END #e%eeee 
IF (KRUFFL eNEs 3) GO TO 360 
IF (NBUFFL «€8.7) GO TO 363 
IF (ISTOP .EMe 7) GO TO 363 
GO TO 37% 
CoNTINUF 
NWRD = NCHRCU(LLINK)/NCHRW « 4 
NEXTRA @ NCHRUIN(LLINK) © (NWRD@)) ®NCHRW 
IF (NEXTRA e£U.4) NYRD = NWRO eo } 
YRpCOCT = JRCUCT * 1 
ITA = NNFCUR 


ee%e INCLASSIFTED ee0® 12/14/76 PAGE NO. 


oov 


ere 


_—— eee eee, 


aae@ UNCLASSIFIED #*#* 12/16/76 PaGE NO, 
WRITE (MOT, 301) XFSNXe KNFCUR,ITA »JRCOCT,KNBFPA,KNAFPBs 
2 ORNYOACLL) oL ba 1 eNweD) 
sol FORMAT (alsAgelXeAgelSelXoAseagelxellalo) 
C#*@ee8yGG STAT es eresatene 
IF, 18uUGR NE» 1, GO TO 372 
WRITE (MO eo 301) KFANXe KNFCURSITA eJRCOCT. KNBFPA,KNBFPOSs 
L(KNXDA(LL) eLbL2 1 e#NwRO) 
372 CoNTINUF 
C#eeeeBuG END #000%ne 
KRUFFL = 0 
302) ConTINQue 
IF (KBUFEL eE4.1) GO TO 360 
IF (NBUFFL eNOei) GA TO 364 
KFBNX 3 NEBNA 
KNFCUR a NNFCUR 
KNFNXT = NNFENXT 
KRCTNX a NRCTNX 
KNBFPA = NNBFPA 
KNRFPB = NNBPPS 
Oo 365 LL = 1075 
KNXDA(LL) # NNXDA(LL) 
305 CoNTINUF 
LLINK = LLINN 


NRUFFL = 9 
KRUFFL = 1 
364 CONTINUE 
Cc 
Cc 
¢ 
370 CONTINUE 
c CHECK FOR INSERTS 
IF(NIST 69.0) GO TO 380 
Cc WRITE INSERTS 
c FIND SMALLEST 


MFIPVA = 599999 
MFIPVB 2 449990 
LTYP = 9999 
00 373 L & ye NSPNU 
Tr (YSPFST(L) eNRoy) GO TO 37. 
IF (USPFOA(L) ate YEIPVA) GO 19 373 
IF (TSC .EQe 1} 1GO TO 374 
IF(USPFOR(L) .GTe MFIPV3) GO 79 373 
3t4 CONTINUE 
MEIPVA = JSPFPA(L) 
MFIPVR = JSPRPA(L) 
IF (ISPLST(L) «GTe LTYP) GO TN 373 
LYrYP 2 TSPLST(L) 
lu ee 
373 CONTINUF 
IF (NBUFFL o€4.7) GO TO 369 
NEBNX 2 JFBSP (LU) 
NNFCUR = JSPCUR (LU) 
NNFNXT 2 JNFSP (LU) 
NRCTNX = JRCTSE(LU) 
NNBFPA 3 JSPFPa(LU) 
NNBFPB = JSPFPR(LU) 


OO 375 LL = 1035 

NNXMA(LL) 2 JSPRA(LIeLL) 
375 CONTINUE 

LLINN = ISPLST(LU) 

JSPFST(LU) 2 4 


eo%e i NCLASSIFIED seee 12/14/76 PAGE NO. 


aa%e UNCLASSIFIED #808 12/16/76 
ISPFSTi(Ly) = 0 
NBUFFL = ] 
NIST 2 wIST = j 
GO TO 369 


CONTINUE 

ADVANCE FROM ™ RUFFER TO N BUFFER 
If ({STOP ,NEe4) GO +O 381 

CHECK FOR INSERTS aFTER LAST INPUT RECORD 
INSERTS PUT IN TN ORDER THEY APPEAR IN THE SPECIAL BUFFER 
IF (NSPNU .EG2e0) GO TO 387 

Oo 37; a yeNSPNU 

TF (JSPLST(L} eNEe2)} GO TO 371 

IF (JSpFST(L) .«Foqel) GO 7O 37) 

IF (USPFPA(L) el Te KNOFPA) GO TO 371 
IF (JUSPFPA(L) .Gte KNBFPA) GO TO 368 
IF(ISC .EQe7) GO TO 366 

IF (JUSPFPB(L) aL Te KNAFPR) GO TN 37) 
IF (JSPFPB(L) .«GTe “NBFPB) GO TO 368 
CONTINUF 

TRC ISPLSET(L) eLTe LLINK) GO ro 371 
CONTINUE 

NFBNX = JFBSPI(L) 

NNFCUR = JSPCUR(L) 

NNFNXT = JNFSP(L) 

NRCTNX w= JRCTSP(L) 

NNBFPA ws JSPFPa(L) 

NNRAFPB @ JSPRPR(L) 

DO 367 LL 2 leleg 

NNXDA(LL) = Jy_0A(L ebb) 

CONT INUF 

JSPFST(L) 2 1 

NBUFFL = } 

Gq ro 3A5 

CONTINUF 

CONTINUE 

IF (NBUFFL eNbe fe .ORe KBUFFL eNEe 0) GO TO 38S 
ENOFILE MOT 

ENOFILE MOT 

RewINn MOT 

Re TURN 

CONTINUE 

TO FINISH SINCE ALL DATA HAS SEEN USED 
IF (NBUFFL e€Me7) GO TO 360 

NNFCUR = gMSTUP 

GQ TO 360 

CONTINUF 

IF (NBUFFL e€W.7) GO TO 360 

IF (MBUFFL eFWeR) GO TY 339 

NFBNX ®& MFBNX 

NNFCUR = MNFCUR 

NNFNXT = MNENKT 

NRCTNX = MRCTNX 

NNBFPA = MNBFP A 

NNAFPB = MNRBFPA 

O00 382 LL = jeye 

NNXMA(LL) = MNXPA(LIL) 

CONTINUF 

IF (J000 »EU.0) GO TH 383 


oeee (NCLASSIFTED eae L2/l4as746 
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00¥ 


356 
354 


353 


oncan 


ae@e UNCLASSIFIED 
OO 384 L = leNgPNy 
IFC ISPFST(L) eNEe2) GO TO 384 
ISPFST(1) = } 
NIST 2 NIST @ 7 
Conti yur 
CONTINUE 
J00D = 4 
CoNTINUF 
LLINN = LLINM 
NRUFFL # } 
MBUFFL = 9 
GO TO 339 


aeee 


aeee | NCLASSIFIFN seee 
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COMPUTER PROGRAM DESCRIPTION 


NAME: SNORT 

SYNOPSIS: Simple General Sort Program 

TYPE: Utility 

USE: Alternate procedure for sorting a deck of cards 


BACKGROUND: Developed to sort urbanized area tract data. To re- 
arrange urbanized areas from alphabetical to FIPS code 
order. 


DESCRIPTION: Sort routine reads blocks to disk, saves a key, sorts 
the key, and reads from disk according to the key. 

INPUT: File to be sorted 

OUTPUT: Sorted file 

STORAGE: IDA Card Deck S-2 

DOCUMENTATION: Attached sheets; see Run S-24 for example of use 


LANGUAGE/SYSTEM: RUN(FORTRAN)/6400 SCOPE 


COMMENTS: Direct, simple FORTRAN code, but requires random access 
storage capacity 


NOT 


WH - £,LMer 
Berets TIO 


I[=229 


nae 


This routine sorts blocks of records according to a key. 
A group of records, here 3000, is read into core storage. Either 
the whole group is written onto disk, or if the key changes, 
each key group is written separately. The keys are sorted and 
records are read from disk to core by the key and then written on 
the sorted file. This routine is only efficient if the total 
number of groups is small compared to the total number of records. 
To sort different types of records some program statements 
must be changed. These are flagged in the listing. One position 
in the array IAR must contain the key and only the key. This 


position is set by the format stacement in the subroutines REED 


and RITE. 


-: 
’ 
: 
’ 


23 


ey 


e5 


eee HnCLASSIFI pn o8o* 12/17/76 PAGE NO, 096 | 
PROGRAM SNURT( TINSaQues TOUTS4902— TAPE2=1 ,UUTPUT) J | 


SET FOR FILE TO BE SOHKTED AITH EACH RUN@@ Gene eeetoannenvaene 
CoMan i Am CL 2931) oKEYST (SOU) eKEYNO (S00) #KEYOR 1590) sINU(SON) 
COMMON/SENU JT 9M U nh tod ht» ly sa fore 


7 


-{—~7 + rl] a hh o Pb 
My = @L TOUT cet ee rv Ke Agree bh 


MT = 3LTIN ere Ef 
MQ = 4LOUTPUI oe 3 
SET FOR FILé TO de SUKTED WITH EACH RUN@#@SRPPPeteoonounans 


KeYO = &H * 
MAXKEY = 509 7 


MAKOIM = 3u3u 


Iw 2 43 \ - s / 4 
Ik = }3 _ iS fLeuts by wt Cr /AG at f-} 
ILTSt = 09 
Ic!ist = 1 


wAkCuT = 2u00 
MA,CNT = 9YIN4NSS 


CALL OPENMS (eg TAU ,S%l 00) 
Ich? sa 

Two's 
TYA 
[st 


~~ # a -6 


K = 

wAITE (MNS) 

FORMAT CIAL) 7/7/79) °K9 PRUN OF GROUP SORT PROORAM %e///o6 

14 LIG7EU meLew aHE GHP NSF INAL RECORD IN GHOP NO @SUR> KEY 


22 NO REFORUS IN GROUP e/7) (a 
Cant INUF 
fost 3 anes fy, ff, 
CAS L484 


a 

Ie cl gb&e MAanTw) BA TO 1) 
tRaIS = 4 / p 
60: FT) 3a LAavrt*o a 
Continue 

CALL REFD Lan(leld ets) 


ITE (SOR OMT) 26972 

CONT INue 

Tit 2 1 

GO T) 3a 

COnTiInur 

Fen? = FENT = 3 

Te CTCNT eL Te MAXCNT) GU TO 20 
TIN 2 { 

GQ TO a0 

CONTINUE 

IF (KEYO oFQ. [AR(IKeI)) GO Tn 19 
IF (TST NEON) GO TDI 45 

KEY, = TAgiTnel) 


Ist 2-1 

GO T) Ja 

Can TiINue 

TAIG sa } s 

CosTi ye PPR! GET eC eB: 
tan. fe? WG 0 Broft4 act 
CALL wRITMS (aelAtcy ey) eTWDen) “4 


sae CLAcGcIF TIEN o@e@ L2/17775 pAGE ain. 00° 


Hee VNCLASSIFIFEN #ee# Le/1 7/76 
KFYcT(R) = KeyQ 
KEYNO(K) os YT @ 1 
Tr (ILIST eNt. ,) GO TO 39 
WRITE (MMe30) NeTCNT, KEYST(K) y KFYNO(R) 
FORMAT(IH 9 2OX0e THeStoTlossxedlOvl10) 
CANT INUF 
IF(IIN .EQel) GF TO SY 
KesK e 
IF(K eL LE, MAXKEY) GO TO 34 
WRITE (M935) 2CaT 


FORMAT(///91"09 ® ERRUK STOP aFTER READING #slos9 *#RFCORDS SINCE TO 


Tg MAyY GRQUGS FaARMEN eeereeecencen® =) 
STCP 34 

CONTINUE 

TF (I81G .€Qe1) GO TO 32 
REYO = TAR(THoT) 

DO 31 J = leis 

TAg(Jel) = TAn(uel) 
CONTINUF 

E = Y 

GN TO la 

CONT INUF 

5 a 

GN TO Ja 


ConTINUF 
CALL ORNNS(KCYST#KEYOR 9K) 
KK = 0 


CONTINUF 

KK = KK « | 

IF (KK eGT. K) GC TO luo 

Lo = KFYAR(KK) 

Iwo = Iw#KeyNo(L) 

CaLL READMS(peTaR(yo})9 T4D9L) 
LL = 0 


CONT LUE 

Ehste out 

IF (LL eGT. KnYIC(LI)GU TU 49 
Caui. AITE (LAN (, eLL) eI) 
TwovT = IweNI + 1 

GH To 7A 

CONTINUE 


ENUFILE MU 
ENDFILE MU 
WRITE (MMe1y1) TCNTe TWONT 


FORMAT(///91H002X e®TUTAL RECORDS READ =#o 11094 TOTaL RECORDS WR 


Lipre-, seeTl 99777) 

STOP 6409 

ENN 

SUXPOUTINE RREN (TAQ Ni) if 
COMMIS SEND /MT e¥U Afr fi: 
DIMFNSIAN LTaAR(N) 

REAN(MTe21) LAR 

SFT FOR FILE TO SE SURTED WITH EQCH RUN® SOO ee oetagesneoees 
FORMAT (2A, q94S) 

RE THI e— 

EnTey &rTe Ot My Hk. 


4 


Pets VO \CiASSteren S@e~ O° 12/17/76 


PAne NO. 


000 


oa? “ic 3 
AQTTE(MI199)) TAK @ IINCLASSTIFTEN e%e8 
RETRY , oor 
Ent 


ir rN * aooe ea 5 nor 
UNCLASS - * / 
I as 2/1777 
AGE NO 0 
vate SSTFIEN 7 . 


COMPUTER PROGRAM DESCRIPTION 


ppb 


NAME: BOX 
SYNOPSIS: Produce GBBA, GBBC, GBBD files 


TYPE: Single Use 
USE: To put Medlist Block Group Records into Standard File format 


BACKGROUND: Part of Standard File conversion. This program developed 
instead of use of MESHFL to save computer time by pro- 
ducing several output files at once. 


DESCRIPTION: Direct conversion of file format. Maximum and minimum 
latitudes for each urbanized area found. Corrections 
added. 


INPUT: Medlist files 


4 OUTPUT: Standard Format Files GBBA, GBBC, GBBD 


a 


STORAGE: IDA Card Deck S-3 


DOCUMENTATION: Attached sheets; see run S-27 


LANGUAGE/SYSTEM: RUN(FORTRAN)/6400 SCOPE 


t 

® COMMENTS: File GBBD contains only header type data; Data are read 

é into K buffer and written from M buffer to allow attaching 
: TYPE of next record, and for corrections. 

eo 

* 

4 

r MOT 


receding F0@ BLAIWA - gp yyed 


@aee (INCLASSIFIEN aeee 12/17/74 PAGE NO, 000 
| PROGRAM BOACLNPLT@MITPUTOTINe TONTAsTOUTBsTOUTCe TOUT) i] 


To PRODIICE “RNLTST GH549GBBR.GA8CeAND GSBD RECORUS FINN MIN AND 
MAX LalTTTUUFS AKU ADU CORRECTIONS TU DaTA 


— 
aqoaca 


DIMENSION LSTCS(150)9 TUAC(150)e ITRTC(1S0)» IPOPH(150)9 FLATO(IS 
10) » FLANO(L90)— FLATH(LS0) «© FLONA(150) 5 ISTCC(159) 
A DIMENSION LuvC(e0) et4VU (20) mere ea" cea 
| mp = SLTNPUT frctisives 
SLOUTPLUT ¥ 
3LTIN 
SLTOUTA 
gLrouia 
sLTOUreC 
sLTOulr® 
Tes) = 9 


= 
Qe 
iunukhu 


s''949n9 
S3i94029 
2754-7) 
31494559 
34346029 
Q3458) 
sh5ar69 
3734579 


—— 
- 
> < 
< 
Y 
~ 
~ 
“ 


Iwve (7) 
Iwvc(a) 
Nwv 24 
DO ST = jes 

| Iwvi(t) 2 9 

: E) Can TIQur 

IwVCO = S5xa4009 

MSKA s 7777 u00900900907000008 

Mok = 40379u00000000V000008 

SX = Ae 

Sy 3 ne 

SXX @ is 

| SyY = 


st 
= 
5 
wn 
uouonnunuu 


2 
e 


SxY = 
FLOMX 
FLOuUx 
FLAAN 

| FLOM 
Tpovt 
TpoPR 0) 
NRCIIA b) 

| IT°SH SHI d 


Je 

4e 
999346 
WDIGI© 
a 


ITPSHFS GHL-5A 
IFOrCT = 9 
JTRFCT = 9 
ITPTR = 4HGASC 
ITPTIF = ghGnHC 

| JSTCT 0 
IgTPT 0) 
Tyaco 4H 
JiyACcoO 4H 

| KHOT = 4HG0R8U 
KHL TN 4HG40I) 
KTPrT t) 
KTeCcR 440RBK 
KTPCN 64G79n 

| KAICT (a) 
NPEC @ 4 


nunhuu 


Sate inc) ASSrF FD ote? L2s7hk7/746 PALE nO. 000 


‘ saitied St — ial om. 


” “ere 


17 


10 


l2 


ll 


lo 


13 


14 


lo 


1> 


aoa 


20 


2) 


22 


23 


fate \INCLASSIFTEN #¢0# 129/177/76 PAGE NO, 000 
KAT = 9 2. 
KNTMX = 1000 
KNTMX = 2909 
KNTMX = 2700 
KNTYX 3 999999 
KNTMN 2 l4ua 
KNTMN = 0 


(ey 


WRITE (MO_17) 
FORMAT(VH] 9///////y19K9*® LIST OF CORRECTIONS TO INPUT TAPE GBBA I 


1N THIS PUN OF ACK PROGRAMHs////) ae ae oe 
I 0 Ve ee 
wie, 0 “ core 
CONTINUE 
le Coed 


REAN(MP,12) ISTCC(T) eIUAC(I)« ITRTIC(I), IPOPH(I)»® FLONO(I)» 
YFLATO(1L)» FLUNH( I), FLATH(T) 

FoRMAT(ASedSxX* AGHLIAK9IOg 7 Xe Te bXoF Tobe F Oadby FT7e49F6,4) 

WRITE (MMe LL) LSTCC(T) eIUAC(I) >» ITRIC(I)» IPOPM(I)® FLONO(I)» 
yFLATO(I) 9 FLUNK (I) e FLATH(I} 

FORMAT(IH 9 woebXeAgeloXsAge 7X9 lererXe oF 8eqgelX9 oF Bey) 
IF(TSTCC(L) eyE. S4sTupp) Gq To 13 

ILNG = 7 © } 

tJ s.d i 
WRITE (M913) = 
FORMAT (1H19////7910X9% NOW REGIN PROCESSING INPUT TAPE®s///////) 
Go TO 2a 

CONTINUE 

IF (J .GTe9) vO TO 14 

IstcS(,) = Istcctr) 

Js 1 

60 TS 15 

CONTINUE 

00 16 JJ = Led 

IF(TSTCc(l) ee&9, ISTCS(JJ)) GO TO 15 

Con TI Que 

Sig de 1 

IstcS(J) = frsTcc(y) 

CONTINUE 

GO TO lp 


CONTINUF 
REAG (MT, 21) KFANXeKNFCUR sKNENXT @KRCTNX 9KNBEPA sp KNBF OB 9 
KDA sKNBeKDC eKCUOKDE?s 

KTFECTeKBLGP PRE OKNSE 9KPOPs XLATsXLON eXCENT 

FORMAT (Alsager lXeAge ASHIX GAS HAGOIXOGAINSATOAGeIXeAl SIX Ass 
1 216s2FR.401 468) 

IF (EOF s4T, 72,22 

CoNTINUF 

IeENn = 1 

ITPSHF = 4HSTOP 

ITPTRE = 4hSTOP 

KHOTN = 4HSTUP 

KTPCN 2 6HSTUP 


GO T0 24 ———— 

CONTINUF Vert Virgenes & 

I7M = KNBFPA «AND, MSKA ‘ oe 

IF(TTM ,NEe 49K2) GN TO 129 p aye pe 

IF (KNBFPA EUs 856039) GO T9139 00 7 yp oN fa or BO Ley 
- 20 oe y, / 


ra) 


12/17/76 PAGE NO. 000 


fete inc, ASSTFTEN #008 — 


126 


128 


127 


130 


125 


lel 


123 


122 


oe 


ol 
63 
120 


ee 


2s 


#ete UNCLASSIFIED eee 12/17/76 PAGE NO, 000 
IF(KNBFpA ofue THVCO) GO 70 125 : 3 
00 126 tf = 19s ’ 
IF (TWVCO e&Qe IwV¥C(1)) GO TO 1la7 vit yr ane fit 
Cc ntl Via 4 +4 
WRITEUMQ,123, KNFPA,KNBFPG, KTRCT, IWVCO fpr ten co i 


FORMAT (1g o@///21N HVA NO OLD COVE MATCH AT®sAS#AGy1X,AG9AS ) 7 “ 
IwV¥CO 3 KNGFRA 

GO TO 1295 

CONTINUE 

Iwvu(t) 3 1 

IwVCO = KNOFRA 

Go TO 125 

CoONTINUF ) 
IF(KTRCT .NEe 640107 eORe KEN .NE~ SHQOSS ) GO TO 125 
IwVU(s5) 3 4 

GO TO 195 

CONTINUE 

Do 121 Tt & 104 

IF (KNBFPA eEYe IWvC(I)) GO TO 122 

ConTI yur 

WRITE(MN,)23) KRCTNX,KNOFPA,KNGFPB,KTRCT,KBLGP,KED 

FORMAT (yHqs ®///IN WVA RECORN DOESNT MATCH AT*sASeAS Age] Ae AGeay? 
As) 
‘bo TO 1290 

CONT INUF 

IF (TWVU(T) .NWEe 1) GO TO 61 

WRITE (MQ062) KNAFPAsKNBFPReKRCTNXPKTRCTOKBLGP OKED eI o TWVU(T) 
FORMAT(1H 9@ wevVA, RECORD DROPRED AT %» ASoAgreXPAE 2X eAGPAly 
1 ASe* FLAG ss 13413) 

GO TO 2n 

CONTINUE 

WRITE (M0963) KNRFPA,KNBFPB oKRCTNX sKTRCTSKBLGPOKED oI TWVU(T) 
FORMAT(1H 9# wevA, RECORD =2KEOT= AT #, ASeAGreXPAGe2XeAGHAly 


au pet tne 2 
CONTINUF [CRS ae a 
IF(KPOP «EG, 0) Go 10 20 Wit o Afr Lad 
CONTINUE 
KT sz KNT © [| | 
IF(KNT .LTe KNTMN) GO TO a9 EA fw ne 


IF(KNT ,LEe SNTMX) GO TO a5 
IEND = 1 

ITPSHF |= 4HS10P 

IvP TRE = 4HSTOP 

KHOTN 2 GHSTUP 

KTPCN @ GHSTUP 

CONTINUF 

IF (ISTRT o&-1 ) GO TO 28 
Istret 3 } 

TuacO 2 KNSFYH 

JUACO #@ KNSFKH 

MNRFPX = KNBFPA 

MNREPY 2 KNAFPR 


GO TO Si i 
a 

CONTINUF 5 

vo 32 I @ lelyu ox “f fo pvetlr 

Ie (MNAFOA cE. TSTCS(I}) GO TO 36 ' 

CONTINUE 

Go TO 33 

CONTINUE 


POSSISLFE MATLHe NOW THY TRACTeETCe 


Ose in ClacelFIEN eee 12/1747h PAGE wn. 000 


36 


35 
33 


65 


31 
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*#e** UNCLASSIFI¢pn eeee 12/17/76 PAGE NO, 000 
00 35 I = 1,1LNG { 
IF (MNBFPA, Nee TSTCC(I)) GO To 35 a 
IF (MTRCT eNEe ITRTC(I) ) GO To 35 

ITM = KTPET + } 

WRITE (MQ930) IPCPsTPOPH(I)» ISTCC(1)» IYVAC(T) eITRIC(I) » FLATeFLONe 
y FLATH(T) sFLUNH(T) eKNTOITM 

FORMAT (1HO9#*-"0" RECORD CORRECTION/OLD@NEW POP 2%,21Q99% STCTY=UA 

WC. TRACT CODE 2, ASe2XeAGy2x Abe vso® OLO/NEW(LAy/LON) & %, 
2 2F9e4eSXe2h9ede * ALL AT IN/OUT RECORD COUNT = 4,219) 

IF(IPOP oN&e IPCPH(T)) GO TO 45 

FLON 3 FLONK(T) 

FLAT = FLATRII) 

GO TO 37 

CONT INUF 

CONTINUE 

CoNTINUF 

IF (ICENT .NEe5H26947) GO TO 45 

IF(FLAT eLTeaae) GO TO 65 

WRITE (MQ 960) 

FORMAT(1HOs * REPLACE LARGE NEW YORK LATITIDES@se//////////%) 

FoRMAT(TH 9% se=pEpLACE Fagman®s ASsAbr2x9AOvAlsASe2xeASe 
1 2X%.19 2X 2F8.4) 

WRITE (99987) MNRFPA,MNBFPR, “rRCT» MBLGP»MENsICENT,IPOP. 
1 FLAT,F ON 

FLAT 3 a0e7TSYe6 


ConTIQur \ 

KTPCT = KTPCT « 1 ‘Roni ee 

WRITE (MD921) MFBNXeKTPCRyKTPCNe KTPCT, MNBFPA»MNBFPB, 

1 MOaeMUReMUC eMUN eMDE 9 % 


2 MTRCToMBLGpeMECeTHsEsT pope FLATeFLON gICENe 


JSTCT = USTCT . 1 | 
WRITE (MAo31) MFANXeITPSHeITPSHFs JSTCT»MNBFOAeMNUFPB, 

1 IPOP,IHSESFLATeFLON® MTRCTeMaLGPeMEDs ICENT 

FoRMOT (AL SAG LXsAGeTSOLX9ASodby UxeTBylTe2F8eSolxeAGolXeAlolxs 

1 AS,1%,45) 


IF(IEND eEQ.t) GO TO 47 
IF(KNAFOB efue JUACO) GO TO 45 


CONTINUE 

IF (IFORCT eFe3) GO TO 46 
NREC = 2 

Tpoeo 2 9 

FLATD # 9 

FLOND = 9 

Tpopc = [pop 

FLATC = FLAT 


FLONC = FLON 

IF(IFORCT of %e7) GO TO 46 
NREC = 9 

Iporc = 0 

FLATC 2 9 

FLONC 2 9g 

Ipnpa = [pO> 

FLaTa = FLAar 

FLONB ® FLON 

IF(IFORCT «Ze7) GO TO 46 
NREC = 4 

IpoP8 = 

FLATS = 9 


@e%e IINCLASSTFrEn aee® 
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RS aye = . RS ~ 


ee 


eS 
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42 


43 


44 


66 


a9 


eeee iINCLASSIFTED ee 12/17/76 FAGE NO, 000 


FLo..3 
IPOPA 
FLATA 
FLONA = FLON 

Gq TO 4A 

CONT INUF 

IFOPCT = IFORCT ¢* 1 

GO 10 (4) 942943944) sIFORCT 

CONTINUE 

IporA = ITPUP 

FLATA = FLAT 

FLOMNA 2 FLON 

GO TO oa 

CONTINUF 

IPOPS = IPOF 

FLATB = FLAT 

FLONS = FLON 

GO TO 4A 

CONT INUF 

Ipnpc = 1TpUuP 

FLATC = FLAY 

FLOMC = FLON 

Go TO 4A 

CONTINUF 

IpOPO = IPCP 

FLATO = FLAI 

FLONO = FLON 

CONTINUF 

IFOPCT = 90 

JTRECT = JTRECT © 1 

WRITE (MBs 49) MEBNXeITPTReITPTRE sJTRECT® MNAFPAyMNBFPRy 
INREC, LPOPm, FLATAsFLUNAs IPOPR FLATS oFLUNB»s TPOPC eFLATCyFLUNC, 
2 IPAPDSFLATOSFLAND eICEQT 

FORMAT (Al AG g1X AG TS yg IX ,AS,AG,IX, 11,4118, F804,FH.4) ,1X,A5) 
NREC 2 4 

JUACO = KNBFPH 
CONTINUF 


IPOP nm 


IF(TENO EG 1) GO TO 84 1 , 
TF (MNAF RS stus ruaca ) GO To 8l De 
CONTINUE 

PoP = IP0PK 

Cala = SY/FOr 

CGLO = SX/POoP 

Cy = 69,3735e289 

Cx 2969,17382292 #COS (CGLAS3,14159205/190e) 

Sxx = SxxsPor 

SxY = SxY/PCr 

Syy = SYYsP%r 

XX SXx = CoLO*sCGLO 

YY SYY = COLA@CGLA 

XY SXY¥ © COLASCGLO 

XX AKOCKFCA 

YY YYeCy*Cy 

Xy = XKYSCxecy 

SGXX = SQRT(4nS( XX)) 

SGYY = SORT(OHS( YY)) 

SGXY = SQRT(4anSt XY)) 

TF xY ells ned SGXY 2 © SGxy 

IF (AdS(YY © KX) 6 GT © yegguay)? 99 TO SQ roy 


@ove iiNCi ASCIFTEN ofee 12717776 PAGE no. 000 


To 


ET 4 


33 


55 


So 


So 


63 
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#e*@ IINCLASSIFIED #¢0® 12/17/76 PaGE NO, 0900 
TTHETA = .5%35.14159765 é 
Go TO 52 
CONTINUE | 
TTHETA = ATAN(2,#XY/ (YY © xx)) | 
CONTINUE 


THETA 2 TTHEIA/ 26 

SINO 2 SIN(THETA) 

COSO = FOS(THETA) 

SINS = SINU@SING 

coss = cdsu*cuse 

VARKX 3 XX#CUSS = a,*SINO#COSU*AY + YY#SINS 
VARYY 3 YY®CUSS * a.*SINO#COSN *#XY * XX*SINS 
IF( VARKX eLT. VARYY) GO TO 55 

VARRB = VAHKA 

VARLL = VARYY 

ALPHA = 05%30141592465 
GO TO 5a 

CONT INUF 

VARLL = VARXA 

VA8RB = VaRYY 

IF( THETA eLTe ne) GO TO 56 
ALPHA = THtTa 

GO TO 5A 

CONTINUF 

ALPHA = 3,14159765 + THETA 
CONTINUF 

ALPHAD = ALPHA®180./3214159265 
THN 3 0.5%3014159265 = ALPHA 
SGB8 = SaRT(AKS(VARRB) ) 

S6Li . SQRT (AHS VAQILL)) 


IF( VARLL eLTe ne) SGLL = ge ee 
KHOCT = KHUCT ¢ 


WRITE (MCyq3) MFANX» KHOTs KHOTNe KHOCTsMNGFEXeMNUFPY, TPOPT+ "9, Thilp Ma bebe: 
1 CGLAeCALOe PLAMNOFLAMX oFLOMNGFLOMXONRCUA yg ICENT : 
2 6SS5BB 9SGLL,ALPRKAD 

FORAAT(AL GAS OLX eAGe TSOLXoAS ebb alXo [Fe 2FB eho lXe2FA del XecFbeselSs 
1 1%sAGS9 lXsor TearF Tea) 

WRITE (M992) MNRFOXeMNOFpYs KHNCTs JSTCTeJTRECT® Tpnpte Ipiypyre 
1 CGLAsCGLOs FLAMN»FLAMXs FLOMNePLUMX» NRCUAGICENTs JRANeKRANGURONG 
2 KRON, IRAAeRRAXPIQIOXOKRUK, IRAN JAUNG JOAX 9 IBOX 

FOKMAT( 1LHOs ASeAGe SBL7y 219, 2F9e49 2x92F9, 49 2X92F 94Gb, 

V T6e2X AS gS e818 eSXe 4(AG91X)) 
SX = Ue L anon 


Sy = Oe - : = 


* THETA 


x 
2 
2 
uuuen ne too 
ry 
o 
ra 
r 
< 
e 


Tyacod 
MNHFPX = MiVRr WA 

MNHFPY = MySPeR 

CONTINUE 

IPO®T = [pyeT »« [PpNe 

TECFLAT oh fe men01 oORe FLON oLTe Ne001) GO TO 91 
TPOPR = TPyom + TPAP 


d-e4 
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lol 


loe2 


103 


104 


159 


@ue@e HINCLASSIFTEN #00 
Por = LPpoP 
SX ¢ FLUN#eOP 
SY + FLaT#e0P 
SxX = SKX @ FLOR PELONPPOPR 
Syy = SYY + PLAT*FLAT*POP 
SxY = S¥Y + FLOR #FLAT#POP 
IF (FLAT.GEe PtAmMN) GO TO 101 
FLAS) = FLAT 
JRAN 3 JSTCT 
Kaan = JTRECI 
JBON = MTRLT 
CONTINUE 
IF (FLON «GE. FLOMN) GU TO 102 
Flo4y = FL 
JRO ste? 
ReON = yTRccl 
JBON = MTRET 
CONTINUF 
IF (FLAT eles FLAMX) GU TO 103 
FLa‘¢x 2 FLAT 
JRAX 2@ ISTST 
KRAk = 4TRECI 
JBAK = MTRET 
CONT INUF 
IF (FLON ele. FLOMX) GU TO 106 
FLO 4X 5 FLON 
JROK = JSTCT 
KROX = JTRETI 
JA0K = MTRCT 
CONTINUF ~ 
CONTINUF 
NRCUA = NRCUA 6 1 
IF(IEND ,£2.1) GO TO 150 


CONTINUE 

MPaNX = KEGNA 
MNFCUR = KNFCUR 
MNF IXT = KMENKT 
MRCOTNX = KROTNX 
MNKRFPA = Kit rhPA 
MN“F PR = KNSPOS 
MTRCT = KTROI 
MaLGP = KRUG 


MEN = KEN 
IHSF = KHSe 
Tpue s Ko_QP 
FLAT = xLat 
FLOM = X¥LON 
ICENT = KCENI 


MDA 2 ANA 
MOS = KNBR 
MNC = KNC 
MON = AND 
MNF = KNE 
Go TO 2n 
ComT tinue 


ENDFILE MA 
ENDFTLE Ma 
ENUFILE MA 


#e@e INCLASSTETEN #408 


= ne seb 
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sw 


ENuFILE ma 
ENDFILE Mc 
ENDFILE MC 
ENDFILE mn 
ENDFILE Mo 
WRITE (M9151) 


Ld) FORMATOSS A/c gkePeoeererresoenn OF 


WRITE (MAD iGo) 
1>2.0 FORMAT (Hy) 
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STOP 64q0 
END 
§1¢6569020 TAB4YCEMATNDER OF 4015 9055 0 
21059020 TAB4QHEMATNDER UF 4020 0us6 0 
sinegn2o TABGUREMATNDFO UF4N23 0057 0 
51069020 i PRMATNDES OF 4023 9057 1 
510£902n TAB4QREMATNOFO UF 4023 00S7R1 
siceagn2n 7 REMATNOEQ VF 4023 90S7RBO 
51969N20 7 PemMATNDED UF4028 0051 1 
51141005 (68Q9REMATNDES VF Y312 905880 
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34977136 TSHQLQEMATNDRES VF 046102 0755R0 
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R4I224320%26 
R4IAAGI28913 
R5272n 340409 
9214293209608 
92150032793) 
892919431592 
AQINNNGIE5UN 
A9300043¢5uU0 
AQ2919431la92 
BBDIKPaZ1 CES 
BN 2686269639 
825696265539 
817601261459 
817691261480 
A2TS24629U442 
82752629u4G4) 
82753529u4e) 
B2753829u4e)] 
AaTTa229vae0 
B2772P 2709420 
APAVIAPGY 4D] 


= ADT 4D 29533 
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714667427408 
712225427748 
763913393160 
7463913393140 
758597392436 
746335394753 
766335394753 
767751389851 
236467328035 
842727337740 
943506338777 
R442453360543 
219501334499 
249460325172 
AL92263246026 
R4GHI9325013 
25273034949 
921429326968 
921500375021 
992919431002 
223500431500 
993000431590 
292919431092 
A77CH94282c5 
RO 26086260629 
8oé696260639 
A} TO¥1L3014R0 
R17TENLINLSRO 
87275€6280442 
827526280442 
827555280462] 
A2P7TS2S2R042)] 
R977 26280450 
R?27T7P22ANG29 
A2411929966) 
A278 20289533 


000 
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2219302595304 706 uP UNECIN 5272 «ee 
l2l-3025 TICEQTEMATNDED VF 226990198 
200170151665 3980UFaY ClTY 9910 7 
201439038043 Q932160i ~fanlt g?o7? 1 
3990132005 7 CULERATS TwPo1ly)3 
39013005 TOngyCULERAIN T4Palg3 9 
00947036 TASKUFEMATNIES VFO20L 1 
4U1N9DI6LALSISABYORLAHOMA C1 7106903 9344 
34013 S6nitew vYORK 147 

26077 AT2yKALAMAZNN =—=—-9022011 
#21) K1L6uSMILADELPH1AN18399 2145 
Sora, Sec ivewYerK e695 

3099) Soni AtcwreRK 9564 

Jona) San lh ewYorK 9178 

lel43 706u 3ST FETE 02690) 
STGop 
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82766029123 227560280723 
R2TS3IS29y4e] 827535290421 
83934RG3635 839398436095 
B3ANR2G25245 830882423245 
8998694013DA 4067869491358 
88869401358 4n7#69491358 
981637345240 961637360240 
9565753549868 976575354928 
84179R407/89 7417984977A9 
845150423549 255150423549 
751288409597 751288399897 
73R675447299 738675407290 
737325447210 737365497210 
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COMPUTER PROGRAM DESCRIPTION 
NAME: MOVEUB 
SYNOPSIS: Standard File XBAA editing 


TYPE: Single Use 
USE: Rearrange records 


BACKGROUND: The XBAA file has nodal data. When several urbanized 
areas are in a single county they are listed together. 
In six cases the order is different on this file than 
in Medlist. This rearranges the order. 

DESCRIPTION: 


INPUT: File XBAA-1 


OUTPUT: File XBAA-2; see Run S-30. 


STORAGE: IDA Card Deck S-4 


DOCUMENTATION: Attached sheet 


LANGUAGE/SYSTEM: RUN(FORTRAN)/6400 SCOPE 


COMMENTS: The separate cases are rearranged individually by use of 
two supplementary storage arrays. 
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PROGRAM MOVEUS(TINs TOUT) 


To PUT SEVERAL US RECORUS FROM LK 1 IN OROER OF MEOLTST 
ON GHoCel 


UIMENSION TAR(13)yTARA(13) yITARB(13) 

MT 2 3LTIN 

MU 2 4L TOUT 

CONTINUE 

READ(MT92)) FAQ (lye INU 9 (TAR (1) 9ts2012) 

FokMaT tal ge tSstoaloya?) : 

IF CINU eNEe SU3 eANDe [NU.NE. 4860.AND, INU NE. 4936 r : Pe 
eANDe INU eNEe 2294 ) GO TO 31 (Bt NBD Y 

VO 41 I = 1913 ay: 

TaARaA(l) = IAR(I) Zee (Aea 

CONTINUE 

INVA # INU 

READIMTOEL) IAR (lye Inu 9 (TAR (1) 9Ts2ol2) 

INUST = INU 

Inu = [NUA 

INVA @ INUST 


IaNSTA 3 [AR(1) I 


IaR(l) = paRa(l) 
Tawati) = TaARSTa ‘ 
WRITE(MUg2]) Taw (lyy INU » (TAR (1) 9Ts@yl2)) 24 
ARITE(MU,21) TARA(L)»s [Nuns (TARA(T) 9[s%91) 
GO TO 14 

CONTINUE 

IF (INU eNEe 616) GO TO 32 

00 42 | = 1,13 

TaRaAtl) & TaR(I) 

CONTINUE 

InUa = INU 

READ(MT921) Lam (lye INU 9 (TAR (1) 9fs2el2) 
oo #3 7 = 1,13 

TaRd(T) = LAR(T) 

CONTINUE 

InUs = INU 

REAU(MTe21) Law (lj)e INU ® (TAR (1) 9T=2e12) 
INUSH = INUB 

INUST = INU 

INU = INUA 

InUa = INUSB 

INYo 3 INUST 

TarRSTep 2? JAR(1) 

TaR(1) = yaRect) 

TaRo(l) = TakSTH 

WRITE(MU,21) TAR (Lys TNU 9 (TAR (T) 9 fe2ol2) 
WRITE (MUg2!) Taua(ly» Inuns (TARA(T) sf 2eyl2) 
WAITE(MI 921) TASB(1)s TNUR® (TARR(T) » T2912) 
69 TU 10 

CONTINUE 

IF (INU eNEe 641) GO TO 33 

00 44 [ = 1,13 

TARA(T) =& ITAR(T) 

CONTINUE 

Inva = INU 

READ(MTs21) TAR (lye INU 9 (TAR (1) 9T#2el2) 
00 #5 t # leld 

TaRw(T) = TAK(T) 

CONTINUE 
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INus s INU A 
REAL(MTe2@1) Law (lye [NU » (YAR (1) eT22_l2) 

INUSS = INUB 

INUST 2 TNU 

INU = [NUa 

INVA = TNUSB 

INUs = INUST 

TakSTs ® TAR(1) 

TaR(l) = TAR (4) 

Taku (l) = TaRSTH 

WRITE(MUs21) Tas (hyo INU » (TAR (1) 9fa@ol2) 
WATTE(MU,2L) Tawacty, InUne (TARA(T) oT eey le) 
WRITE(MU,21) Tage lye [NURs (TARB(T) 91291?) 
GO TO 10 

33 CONTINUE [ 
WRITE(MUs2)) IAW (1)9 INU » (TAR (1) 9282912) 

IF (INU e&Qe 5774)G0 TO 40 
GeO rO 10 

60 CONTINUE 
ENUFILE MU 
STUP 6400 
END 
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COMPUTER PROGRAM DESCRIPTION 


NAME: SHUFFL 
SYNOPSIS: Standard File Production 
TYPE: Single Use 


USE: To correct central county code on lost record for an urganized 
area on GBBD file. Compare population on Medlist and nodal 
records. 


BACKGROUND: Output to assist in correction file codes. 


DESCRIPTION: GBBD record is read and then nodal file. Populations 


are compa‘ed. 


INPUT: File XBAA-1; Nodal Data; Central County Data 


OUTPUT: File GBBD 


STORAGE: IDA Card Deck S-5 


DOCUMENTATION: Attached sheet; see Run S-31l 


LANGUAGE/SYSTEM: RUN(FORTRAN)/6400 SCOPE 


COMMENTS: Used to find problem urbanized areas where populations 
do not agree or sizes drastically different. Also to 
correct error from program BOX. 


ed 


oe! 


a: 


“congo 


33 


63 


Pate YNCLLSSIFIEU #00 12/17/76 PALE NO} 00 
PGOGHAM SHUFFL (OUTPUTe TLive es TING s TUUT) / 
MQ= OLUUTPUT 
Ma = 4L TINA 
Ma 2 SULTING 
“Tt = «lout 
Q [3S PUPN® ¥ = OBO 
IcT 3 
SMT = 59.173592232 
aR l TE (40_5) 
FORMAT (Lm 9 //A/7 7/7 4S OK tae eeCUMPARE POPY ON xg <1 ANN GuBdaleoee 
Be/////) 
TcE*TO @ sHolvuss 


Tenu = 0 

ITFN = 4h 

CowriNnue Lear oh p 
REAL (¥O0HK3) MPANKs KrtilTs AADTNe KHOCT»MNGFPXeMNOFPY® TPOPT9 + 

1 CGLASCGLO® FLAYNSFLAMAerLUMNGFLUMKeNRCUR 8 TCENT Let 

© ¢SIGdeSIGLsALPr 3 


Ip (RHOCT e€%ec*7) Ieny = ! 

WGITE(4TeQ3) ME GNKe KRADTe RADTNe KRHOCTsMNBFRPXsMNGFPY®s TPOPTs 
CGLAeCOLO® FLAYNeFLAMAcrL UMNgFLUMXgNVNCUR SIT CENTO 
eS1GSe3IGLeAL?- 

FORMAT (AL OAGHLKPAGPTSPLKILSIAGIILX® TYPOFHaGPLXIZFH e491 KP2FAReGHIS# 
LAeAS elk e2FTevek 702) 

Ict NTO = [CENT 


IFCITPEN eEQe4nUs ») GO Ic 346 'O Pf. 
CONTINUE 
READ (MA,32) ITPN 
FORMAT (8x 9A4) 
IF (EOF eMA) 63562 
CONTINUE 
IFCITPN eNESSnU4 » GO 16 30 
CONTINUE Ht, VP-P 
REAU(MA03]) LTPCeLTPNe LF RAs LE PB eNAMEA eNAMEU SNAMECs IPUPDoFLATPy i may 
FLONP eS1GheSIGt sALpH ae ames 
FORMAT LX AG a 1K eS 9 6AVAT IAF OI X PIAS TIO 2FHe G9 2F Tee 702) 
IF (ELF MA) 63962 
CONTINUE 
TF (IFRP< oNEe MNAFPY) Go Tt 36 
90 TO 348 
CONTINUE 
WRITE (MQ937) ICN Te lFRPAs [FED eMNBF PX eMNSEPY 
FORMAT (# OM ORF eT 72k ent 92XgAV2X Ate 2K gA%) 
STYP 234 
CONT iNuc 
PorP = IPOPP 
PoPP = PapPsl.is 
IpupP = POPP + °.5 AF 
SIGs = 3e#SIGs pray spies 
STGL = 2e#STGL “ & 
MOAw = (FLAMASC ELA) @SM( 4099999 cetthhiy.: > 
MIWA = (CGLA = FLAMN) #S¥I #299999 
Mm 2 (FL AMX=FLAMN) #SMI ¢© 099999 
COSLA = COS(CGLu#3.141SyeeS/1 490) 
“4akO = (FLOMA © CGLO) ®COsLaeSmI #299999 
MINO = (CGLO = FLOMN) ®CCSLA*SMIl © 2699999 
MAO = (FLOMX = ©LUMN) ®CUSLAPSML 699999 
ICNT # IcnT @ 1 
Caw ive 


2eeo YNCL SSIFIEU #e0e ai V2717/76 PALE NO, 00 


ip / 2CEUING or 
7 2 om SV 
LOE Lav rae 


@a9® UNCLASSIFIFL see Ve/1 7/76 PAGE NO. O04 
WATTE (MGs #1) 1Ca Te LRPAg [FEO yNAMEASNAMER OG [PUPT,IPUPPoFLATPeCGLAy a ae 2 

1 FLOP. CGL9eSIG 49ST GL aL eMAXAeMINAs *MAgMAKD, MI VO,mLO o 'e 
41 FORMAT ( IS*IXPAS*AS*IKMAGPAGIDIV® 2X8GFG,492F7,39F T7022 H(1K9lG) ) ronfonde’ 


4 
ae 


IF (TENU .EQel) GO TO 2uu 
Go To 1Y¥ 
20u CONTINUE 
ENOFILE MT 
STUP 6400 
ENU 
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12/17/76 PAGE NO. One 


COMPUTER PROGRAM DESCRIPTION 


NAME: CRDATK 

SYNOPSIS: Produce Standard File 

TYPE: Single Use 

USE: To punch card images of a sample attack, file 


BACKGROUND: Could have been done in MESHFL. Separate program 
written so core could contain entire attack, for 
sorting 

DESCRIPTION: Attack cards are read. Central county codes are 

- attached and the file is sorted on the resulting FIPS 
code. 


INPUT: Attack Deck 
OUTPUT: File IWAD 
STORAGE: IDA Card Deck S-8 
DOCUMENTATION: Attached sheet: see Run S-32 


LANGUAGE/SYSTEM: RUN(FORTRAN)/6400 SCOPE 


COMMENTS: 


euee YNCLADSIFIEU *e0e 12/17/76 PAGE ND, 07 
| PHOGHAM CRDOATK(TNPUT,(0 JTPLT »PUNCHy TIN» TOUT) / 
OTMENSIUN ISTCUS(40n) oe LLACA (aC) 
DIMENSLOM [SCCatl759) oe Juan (1750) eNaMaa (2750) gNaMoa (1750) 9NAMCA (17> 
10)9 [OLUCA(LT5O)» FLaTA(1L750) oFLONA(1750) 9 YLDA(1750) »19R0(1750) 
DIMENSION [COMT (20) 
| Mp = SLINPUT 
= 6LOuTPUT 
MS = SLPUNCH 
= 


IvyePO = 3 

| ITYPO = 2 
Irrepg = 1 
[RCT 2 VU 
ITYr = oAIwau 
ITYPN = eH] wad 

| MSKA = TITTITITITTTTT77IT IS 
MSKn=z 330000000 000000U0UU08 
M§KCS 77000UVUUNONIOVUVUCUGYS 
MSKxus sS59V00U0NUVD0U0UNUNUB 


Sl | WRITE (AU 96) 
, 6 FURMATULHL®7///7 9 1LOXe® PUNCH CARUS FROM OLD CPR WEAPONS FOR SamPL 
' TwAQ STANDARD FILE@s////) : 
f “FHS IF 
toc = J 
F ? | Ich = 2h 
y lal = ar 
: IN 2 0 
lu CONT INUF 
In = IN # ] , Je 
| READ (MPe4l) TSTCOsTUACc Pct ZZ hE Late 
11 FORMAT(SK = s AS LX) orb Gums Creh 
IsicOaqI%) = Istco Seo, 
Tuaca’tn) * Tuac Lesouatoy 
| IF (LUAC eNEo4h932) ) G) Tr ln 
eu CONTINUE 


Sao 
{RCT @2 IrcT * ] Fines Wes: is 
IF (ITY e€0.2) “VU To 3? ] 


| REAO (M2921) SUA, NAMAeNGAMt oNAMC 9FLOD SFLOMGFLOS eFLADeFLAMePLASy 
” ‘ YLuelolvoe : ; 
« 21 FORMAT (1x AS 99K Cal ge AS yCral Ky IXetXg 7E4.00I5) 
8 IF (JUA oNEeGnSTOP ) GO FU 4) 
- Tact 2 IRCT = 1 
j f | GO TQ 29 
‘ 41 CONTINUE 
bs GO TO 33 
+ Se CONTINUE 
NN } | REAL (AT 95]) JUaeNAMAgNAMGeNAMC®9 FLODeFLOMeFLOSoPLADOFLAMSFLAS, 
id 1 YLDsTOLOCs [COneJCODs (ICOM(T) 912196) 
$1 FORMAT (Lig AG e2AL DAG One IU 909 7TF4%,093K9 A491 x9AleA195A109A3) 
py IF (EOF MT) 54°55 
f 54 CONTINUE 
* i | GON TO 29 
“ $5 CONTINUE 
# Cc INSERT RERE wHaT TO 10 Ir UA COUF TS 
53 CONTINUE 
LT = SUA eAND. MSKC 
* | IF CLT eNEeMSRI)) GU TO 23 PP She 
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| | ae 
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JUa = 49K5 JOR, (JUA eAnDe MSKA) 
CONTINUE 

FLUN = FLOD © FLUM/606 * FLOS/3600. 
FLAT 3 FLAD © FLAM/60606 * FLAS/3000, 
vO 25 [ = 1eIN 

IF (JUA eEQe Luacal(l ))G0 TO 26 
CONTINUE 

IsCc = 5H99999 

Go TO 28 

ConTINuve 

IsCc = ISTCOA(]) 

CONTINUE 

IsCCa(IkcT) 2 ISCC 

JUAACIRCT) = UA 

NAMAQA(IRLT) NOMA 

NaMCACIRCT) NAMC 

NaMia (I RCT) Nady 

FLATACIRCT) FLAT: 

FLONACIRCT) FILON 

TolLuCacrRctT) = (Y9Ldc 

YLUA(IRCT) = YLO 

IF(IRCT «Gl. 65) GO TO 2y 


IF ( JUa eNEs 4H4900 ,OR, FLOM eNF 6 35e 


2u 
CONTINUE 

CALL OHUNS(TSCCAsTORDe IHCT) 
vo 35 y = 4y1KcT 

K = [TORD( J) 

IF (J ef IRCT) ITYPN =4RSTOP 
Ioc = [0c + & 


1eslk7/76 PAGE NO. OF 


— 


/ y LJ Yi 


20R © FLAS eNEe 392) GO To 


Ait x FIPS covb 


‘the 


WRITE (MS 932) MFogITYPeITYPNeTOCy ISCCA(K)® JUAA(K) » NAMAA(K) 9 
1 NAMBA(K) »NAMCA(K) 9 ICLelal sTOLDCA(K) eFLATA(K) sFLONA(K) sYLDA (Kk) 
WRITE (M4532) MESSI TYP oT YPN, T9Cy ISCCA(K) 9» JUAA(K) » NaMAA(K)» 
1 NAMBA(K) pNAMCO(KJ9 ICLolAf se TOLDCA(K) sFLATA(K) »FLONA(K) eYLDA(K) 
FORMAT ( a} Ae LKeASe Tg LK g AeA LX pZAlLO AS g AC ary I %y 


1 2F4.49F4.0) 
35 CONTINUE 

STOP 6400 

Exu 
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NAME: 
SYNOPSIS: 
TYPE: 
USE: 


COMPUTER PROGRAM DESCRIPTION 


TOGRID 

Put Block Group Population on Grids 

SINGLE USE 

To produce standard format files QBAA, QBAB, and QBAC. 


BACKGROUND: 


DESCRIPTION: Population tract date is read and allocated to the 


INPUT: 


OUTPUT: 


STORAGE: 


nearest grid point. Three (3) types of output files 
are written. 


File GBBD for General Urbanized area description 
File GBBC for data : 


IDA Card Deck S-9 
See, for example, Runs S-36, S-37 


DOCUMENTATION: Attached Sheet 


LANGUAGE/SYSTEM: Run (FORTRAN)/6400 Scope 


COMMENTS: 

File Type Description 

QBAA Six grid points/record are written each point has 
grid on (I) value, grid N-S (J) value, and population 

QBAB Up to 14 grid points/record are written grid I, J 
value for left most point is written first. Then 
grid population values are written for points moving 
to the right (east) until a grid point with 0 popula- 
tion is encountered when the record is terminated. 

QBCA A map of grid points in each U. A. is produced. This 


is not strictly a Standard Format Data file. 


r aa 


ia 


PF 


| seen (MCLASSIFTED gaa V2/17/76 PAGE NO, 900 
PROGRAY TOLRIN (TINA This TOUTAe TOUTS 9 TOUTCeQUTPUTe TNOUT) ! 


DIMENSION [PNT (29090) 
; DTMENSTAN Lane (a) @ JAH (5) »NPAWR16) oKPOPU(2n) 

DIMENSION Flatt (4) eFLUNT (4) eK PORT (4) 

DIMENSION LNValL (40) eLPRT (149) 9 INUMB(10) 

OTE slay yAME (257) 9AMER (250) 9 TACAR (290) 

DaTaA LNWAL 2 1S ole elHie LH2e1H3elHavlhS® LHeeTH79 INAS Hos 
| 1 letelnaslnaelterlinetnes lneslHGelHHslaLelniel ake libel nme 

DP UMM LAs LHpelkuslHeoltselHrel Mie lMvelwelHxolHYelH7elnes ines 

DATA INUMB 7 IRL og lLHeolAselHseIHSelMOelN7elHoeIHMFelHn = / 


MA gLTINA 
Ma 4lTING | Fat 
MT 5LTOUTA : 7 ial 
My SL TOUTS 
: My sLroutec 
MQ 6LOUTPHT 
| a 


nun bw oawn 


SLTNPUT 
c Ma [5 HEAUER JA GaaUs “3 TS MATA(g IN 2) On GABE 

Meo sc lw 

} MPO = THO 

| | MeeS . 1H) 

4 Ten 2 
IsteT = 1 

MECT = 4ghQbaa 

MRT4 = ANQUEH 

' | MQTY = AHQORA 
MRTYH = 4HuRGEH 

} MQT40 = gnijscaA 
MRT“8H = 4hCoC3 
Inucct = 4 

| Tatisa = 0 

IgiicctT = 9999 
Taisa = 9994 


= 14 
69417392282 
Se 
Je 
ve 
Yeo 


On 


‘ 1 e694 5054O67 tA . f 
' nel 3 a 4 ned fpr hot eee, RE 
Eg ak Gael rfrors Teh Sputh | promt Zeb 
| SPGKD = 24e/9MI0 i. 
SPGOY = 5Ge/5M1LE 
OISTX = 1 e/SPGX 
4 UTISTY = 1) e/SHGY 
‘ | DISTHX = pesPnTStx 
} . OISTAY | Nee*nIeTy 
i . WalTE(YaAeS 1 SeGvecp&r 
y PQS TAT ( IAL 77/7 ° 2iin OF GRID JxPUT PROAGQAMe CELE 
{ # Is patS 9¢N FuekE APE wef aeyge ® GRID POINTS NORTH SuuTH asi 
j | 2,86 400 GRIY pe INTS EAST wEyr Ih EACH MILE as ///) 
ERY ge On 
ht Cati wor : 
b | wate IO CLASSTE TEN ee 12/1 47-44 PaGe NO. 00 


WM OT 
| peceding Fioe BLUM ~ fp yyed 


weee (CLASSIFIED #008 12/17/76 PAGE NO, 
INN = INN @ 
REAN(MP 472) LACAR( INN) »NAMEACTNN) 9NAMEBR (INN) 
FORMAT(LIXs Age SY PAIS 9A) 
IF (TACARCINN) NE, 499329) GO 7O 1) 
60 TO 3e 


ComTl ye 

IguecTt = IaivoCT « 1 

TF (TRUSCT 2Gl. THUS'A) IEND = 1 

On 14 I ® jetan 

LNPRT(T) = ,m 

CantTInue 

REA (MA,2]) MFRAX es TOOUsTRGDNe I CNT 9 KNBFPAGKNRF PB, [TPOPT 

VY gFLATCOSFLEOENCG eFLATYN 9 FLATMX gFLONMN 9 FLONMX eNURECSKCENT 
2eslGAeslGLy ft x 

FOR IAT(AL AG 1K AG AS .1KX_A5 A4. 1K 
1 2F 704 159) %9a58 1%o2F7.4eF Fe af : 
IF (FOF eva) 237922 

Cant (nue 

GO TO 2n0 

Con TINur 

IF (TRGDM geNe4NSTONP) TEND s 1 
JNEFPR = KCEMT 

JNAFPR = KuGrRA 

N90 295 IT = pelny 

IF (KNGFOR EUs TACAP(I)) GO TO 26 
CONTINUE 

NAMEAP = J yYRUNLTSTEN 

NavEBP = Qn 

Go TO 29 

CONTINUF 

NAv“EaP = NANe A(T) 

NAMERP = NAMEN (T) 

Can. tTINveé 

SPECIAL MOUS FOG 2 1/2 AINUTE GRIVMtHtatenaowrteetonseee STAKT 

FLATCUM> 46 
FLONCOf >, ¢ 


» 19 PFRA4 1K AFRO IK, 


FLONCG/246 

SPGAOZ (CAS (FLATCG43414159965/ 1 80¢)) 
DISTX = 1,/6r6% 
OLSTAHK L SHULSTX 
SPECTAL MOUS FOR 2 1/2 “INUTE GRIDG#HPotoneneneeenenene E11) 
DY SMTG 
OX SMICHCOS(FLATCE* 301415994571 Sn e) 
NGY (ELATCOSFLATMN) PUY/I)TSTY+ NISTHY 
NGX (ELONYA © FLONCG )#OX/DISTX* VISTHX 
XULX NEX#UTSTX 
XLY NGY@UTSTY 
It™ (ELATHX = FLATCS) ®0Y/DISTY* NISTHY 
MAXY = "GY » ITY 
IT™ =(FLONCR © FLONMN) MOX/DISTX*® DISTHX 
“MAXX &2 NGK » LTM @ , 
IgKte = 4 
ITM = MAXX Vay 
Tec tt ob tesuate) Gn TO lies 
WRITE (Mane LUT) KAGE aN a KF AgMAKKe MAXY 


Sete HiVNCLASSTE TEN of 0e L2/laste PaGE NO. 


0006 


tate INCLASSIFIEN o¢0% L2/17/746 PAGE NO, 000 
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4 01125 8609 TUSCALOUSA 
21A 48423 9640 TYLER 
145 36n65 8680 UTI C4eRUME 
137 34911 8740 VINELANU@MILLVILLE 
214 48309 B8n0 waco 
42 11lo°1 8840 WASHTNGTON 
41 99009 88AO WATERQURY 
72 19913 3970 WATERLOU 
5> 12n99 R9K0 WEST PALM BEACH 
239 54969 90n0 AWEELING 
34 20173 9040 WICHITA 
224 484ARS5 9920 4TCHITA FALLS 
j H 1346 42079 9119 ATLKES@SARRE 
42> 10003 9140 WTLMTANGTON 
154 37129 92n0 WTLMINGTON 
15% 37067 9220 WTNSTON@SALEM 
{ 137 25027 9240 WORCESTER 
' 192 62133 9290 YCRK 
| 164 39099 9370 YCUNGSTUWN@WARWEN 
| 
| 
| 
i fete LINCLASSIFJFN ##@® - ... 12/17/76 PAGE NO, 000 


COMPUTER PROGRAM DESCRIPTION 


NAME: LLIST F 
SYNOPSIS: Special Purpose Listing 

TYPE: SINGLE USE ; 
USE: To list towns (urban nodes not urbanized areas) in 


order of decreasing standard deviation of population 
to assess nationwide distribution. 


BACKGROUND: 


DESCRIPTION: The input model file is read and urban records are 
stored in core. A sort on semi major axis is made 
and the output printed. | 


INPUT: Standard File XBAA-2 


OUTPUT: Listing 


STORAGE: IDA Card Deck S-10 


DOCUMENTATION: Attached Listing 
See Run S-49 


, LANGUAGE/SYSTEM: Run (FORTRAN) /6400 Scope 
‘ 

Pa. 

te 

If COMMENTS : 
Sy 

y 

. 

. 

* 

* 


NOT 
Fre Blank - £Lmed 


Pie 


, | BecedInG 


{e273 


Te 2m Oe Le 
i eee 


es ee ee te ee 


62 


60 


eee UNCLASSIFIED eene 12/17/76 PAGE NO, 00U4 
PROGRAM LLIST(TIN» OUTPUT) jj 


TO LIST TOWNS IN ORDER OF VECREASING SIGH 


DIMENSION IFPA(2500) sIFR (6500) sNAMA(2500)9 NAMO(2500) » 
1 NAMC(2900)¢ IPC (250019 FLAT (e200) » FLON(2500) 9 S1GK(2500) » 
2 SIGh(2500)s AbPH(2500)»9 INp (2500) 

MY = 3LTIN = ; 

MQ = 6LUUTPUT 

InNON 2 0 

WRITE (MGs 12) 

FORMAT( LHLo//////7920X9*L IST OF TOWN FROM X68 1 (3675) ORDERED 8 
1Y DECREAZING SEMI MauOK axlS@y/////////) 


I 209 
E Per cae 
CONTINUE ; Peetintic atv 
Eo 2b « 1 : 
REav (MT 921) TRECoEHECK SIFPAC(I) sIFPR(T) © NAMA(T) sNamd(l)» muco ly 


1 NAMC(I) » IPOP(T) oFLAT(I) oFLON(I) ® SIGR(T) eSIGL(T) eALPH (I) 
FORMAT (LASAG IX SAGIEXSAS HAYS Lxe2AL00ASs 1992F8e402F7, 39F Tee) 


CONTINUE 
IF(IRECN ,EQe 4xSTOP) GO TO So 
LFUIRECN ,EQ.4HLS ) Gc To 10 


READ (MT, 22) L3ECN 
FaRmMaT( 2x9a%) 
GO To 2u aad 


CONTINUE 
INN = I 


CaLL ORDER (SIG2+INDsINN- —~) Arf dere 


> pal 
CONT [NUE = = ER 7 Nd ~ an) ] pptohe ee 
DO 60 J 2 leINN : 
JK = ha -J* 1 i Pe eet er 
Toa Ty CuK) ALO 
WRITE(MGs 62) J9TFPA(T) 9ITFPOCT) 9NAMA(T) eNAMB(T) 9NAMC (I) 6 ce ab, 
TIPOP(T)»s FLAT(I) sFLON(T) » SIGR(1) sSTGb (1) pabPH(I1) 
FORMAT 1H g1553XsASel KAS ex ,2At0gASySXyI9s FbetolXoF Andy 
b] CAF Te so2roF leds aXoFle2) 
CONTINUE 
TF (LUON eEQe1) GO To 7, 
WRITE (MU_12) 
IpOn 2 
60 TO 58 
CONriNnue 


STUP 6400 
Enu 


#e4@ UNCLASSIFIED ###@ I[-275 12/17/76 PALE NO. 004 


NOT 
Receding Fioe H+ awh - p/yed 


COMPUTER PROGRAM DESCRIPTION 


bY 
i NAME: WPGRID 
x SYNOPSIS: Map Weapons on an Urbanized Area 
TYPE: SINGLE USE 
USE: To produce maps to assist visualizing the location of 


weapons in attack on urbanized areas. 


BACKGROUND: Modification of the program TOGRID to plot weapons. 


DESCRIPTION: An attack file is input and stored. In each urbanized 
area the maximum population range is increased by 20 
points. All weapons in the enlarged grid are associated 
with a grid point. 

INPUT: Standard File GBBD 

Attack Weapon File 


Al OUTPUT: Plots of Weapons 


STORAGE: IDA Card Deck 209 


wrote, oF 


DOCUMENTATION: Attached Listing 


LANGUAGE/SYSTEM: Run (FORTRAN)/6400 Scope 


ae 


COMMENTS: Also outputs files of QBAA and QBAB format. 


ae RY Srna eee 


Wor 
Weceding Foe BLaWl - pyyed 


a 


ey 


HeECEAING 


@e@® UNCLASSIFIED ##00 11/30/76 PAGE NO, On 
PROGRAM WPGRIDI(TINAsTINGs TOUTAs TOUTCs JUTPUTs INPUT» TOUTR) 


OIMENSION IPNT (20000) 

DIMENSION IARR(6) pJARR(6) eNPARR(6) okKPQP0 (20) 

DIMENSION FLATI (4) sFLONI (4) sKPOPI (4) 

OTMENSTON LNVAL (40) ¢LNPRT(140) 9 1NUMBI10) 

DIMENSION NAMEA (250) ,NAMEB (250) » IACAR (250) 

OTMENSION IUACW (2000) #FLATW (2000) 9FLONW(2000) »YL0(2000) » 
1 rCLw¢(200) »IWAT (2000) 

DaTA LNVAL 71H olreolHl, LH20THIe1H4e1HSe 1LHOe1H791HB51H9» 
1 LHOeLHAsLHBeIHCelADslHEs IHF elLHGe lH, lH elHiJslMKelHL,1HM, 
2 1HNS]HOs LHP e)HQsIHRelHSoLHTsLHUsIHVe]HWelHXelHY olHZ9]H*9)HO/ 

DATA INUMB / Lm slH2elhSelHSelHSelHOelH7e1HSelH991HO = / 
4LTINA 
4LTTNB 
SLTOuTA 
5. Touts 
StTouTtc 
6LOUTPUT 
SLINPUT 
Ma IS HEADER ON GBBDs MB IS paTal(s IN 1) ON GpBC 
Mes 2 lh 
MeuO = LHO 
MesS 3 1H1 
IeNp = 0 
strat 21 
MRCT = 4HOWAA 
MATH & 4HOWAB 
MRTY ® 4HOQWBA 
MRTYH 2 4,QWBB 
MRTMP = 4HQWCA 
MRTMPH 2 4HOQWCB 
MSKA 2 TITITITTTITTITVTITFTITT7B 
MSKg = 330000000000090000008 
MSKC 770000000000000000008 
MSKD = 550000000000000000008 
tad z= 1 
IRO 2 0 
1T0H 2 1 
ITOH = 0 
IyVGcT = 0 
InUGa = 0 
Ip¥GcT = 9999 
TRUGA 2 9999 
IRUGMX = 3 
InUGMX = rBUGCT * 20 
IBUGMX = 99999 


z 
Cc 
weunnunae 


ISKIP = 0 

JOVTY = 0 

JOUTMP 2 0 

JouTcT 2 0 

NSSMX 2 146 

SmIC # 69.17352282 
SPGX 2 e 

SPGY = 2. 

SPGX = 1,6666666667 


SPGAO 2 240/SMIC 
SPGY = 26./SMIC 


SPGX 2 1, 
SPGY s 1, 
SPGK 2 Ou 52279 
@eee WNCLASSIFIED see 11/30/76 PAGE NO, On 
NOT 


Page Blank - FiLMes 


opty > 


404 


16 


21 


22 
23 


es 


26 


#e@@ UNCLASSIFIED ##@ 11/30/76 PaGE NO. 00 


SPGY = 024 e 
OrSTx wa 1,/SPGx = 
DISTY ® 1./SPGY 

DISTHX ® VeS*OISTX 

OrSTHY = 0,S*pDISTY 

WRITE(MQe29 ) SPGYsSPGX 

FaRMaT( lple/s//see@ RUN Of GRID INPUT PROGRAM#e////5 


1 * IN THIS RUN THERE ARE *9F8.%s ® GRID POINTS NORTH SOUTH AND 
2*.F8e4e% GRID POINTS EAST WEST IN EACH MILE®sys 7) 
INN ® Q 


CONTINUE ha OA yess 
INN # INN @ } a 


REAO(MP912) IACARCINN) sNAMEACINN) 9NAMEB (INN) 
FORMAT (11x 98% 95x 0A100A8) 


IF (IACAR(INN) eNEs 409320) GO TO 11 So 
Jz0 / / 
CONTINUE fd Wighor? 
Jesey 


genes arses ITTM oFLOD 9FLOMSFLOS of LAD oFLAMOFLAS se YLO (J) sICL Wu) 
eo ITWAT(y) 


FORMAT (1X 646 940% 966450, F4o0,3X914e1XsA2) 
FLONW(J)# FLOD © FLOM/O06. * FLOS/3600, 
FLATW(J) = FLAD + FLAM/60,. « FLAS/3600, 
ITM @ ITTM eANDe MSKC 

IF (ITM eNEs MSKN) GO TO 404 

ITTM @ MSkb eORe (ITTM eANDe MSKA) 
CONTINUE 

TuACW(J) = ITTM 

Te (icuwly) eNE. 5602) go 10 401 

InW 3 J 


CONTINUE |e Seetemetareeeete aoe 


IRUGCT # [BUGCT © } or On | 
IF (IBUGCT eGTe TwUGWX) IENO # 1 Bed msn anrfoniser 
DO 14 1 w 4,140 
LNPRT (7) = ly 
CONTINUE 
READ(MA¢2)) MFBNXeIRGOsIRGONeICNT es KNBFPA,KNGFPB, IPOPT 

1 ,FLATCGeFLONCG oFLATMNo FLA TMX op FLONMN 9 ELONMA eNURECeKCENT 


20S1GHsSIGL»ALPH 


FORMAT (A1 AS el xg Ady ASelXeASeASelxy 1902FBedelXeCEBedelXe 


1 7F8.4 TS51x9A5Se 1X92F7.4%5F 7,2) 


IF (EOF MA) 22423 
CONTINUE 
Go TO 200 
CONTINUE 
IF (IRGON .EQe4HSTOP) IEND 2 } 
JNBFPA * KCENT 
JNGFPB = ST ie 
Do eS yal, 
IF (KNBEPO i TACAR(T)) GO To 26 
CONTINUE 
NAMEAP = 1) QHUNLISTED 
NaMEBP ® BH 
Go TO 2? 
CONTINUE 
NaMEAP @ NAMEA(T) 
NaMEBP @ NAMEB(TI) 
CONTINUE 
SPECIAL MODS FOR 2 1/2 MINUTE GRIDSeeeatenseuresseeevee START 
IF (ITOW eNEo! ) GO TO 475 


#e@@ UNCLASSIFIED seee 11730776 PAGE NO, 0000 


#eee UNCLASSIFIED ###e 11/30/76 PAGE NO. On 


| IFLA = FLATCG#24, 2 
IFLO = FLONCG*24. = 
IFLA = IFLA @ 1 
f IfeLo = Igto + } 
FLATCG # IFLA 
| FLONCG = IFLO 
FLATCG 2 FLATCG/246 
j FLONCG * FLONCG/24. 
i SPGX # SPGXO/ (COS(FLATCG#3014159265/140,)) 
| OySTX = 1./SPGX 
DISTHX # ,S#DISTX 
478 CONTINUE 
c SPECIAL MODS FOR 2 1/2 MINUTE GRIDS#etateetenaeeveteten END 
OY 2 SMIC 
| Ox 2 SMIC#COS(FLATCG#3.14159265/180,) fy foie 
(FLATCG@FLATMN) *DY/DISTY* DISTHY shee 
(FLONMX = FLONCG )*pA/pYSTX* HISTHX 
NGX * 20 
NGy « 20 
NGX*OISTX 
XLY NGyY#DISTY 
IT (FLATMX © FLATCG) *DY/DISTY® DISTHY 
} MaXY = NGY # ITM @ 1 
| ITM 3(FLONCG = FLONMN) #OX/OISTX* OLSTHX "ft 


NGY 

Nex 

NGA 
| NGY 
XLX 


MAXX = NGX @ [TM @ 1 ee 
MaXX @ MAXX © 20 ¥ cy 


MaXY @ MaxY @ 29 =; 
| IE (MAXX oGTe 131) Maxx a 131 

Ie (LY eGT. 159) ry » 150 

ISKIP = 0 

ITM 3 MAXX®MAXY 
| IF (ITM eL 7220000) Go To 106 


er 


WRITE (MG,107) KNGFPAgKNAFPA MAXX MAXxY 
107 FORMAT ( 1Hoe*ARRAY TOC SMALL SO SKIP AT®s A59A492xX0218 ) 
IsKkip 2 } 
j 106 = =CONTINUE 
| C#**#8eKUGGGGGGG6 
IF (IBUGCT eGTe 10) GO To 318 
WRITE (MQo310) OX eDY eXLXeXL Ys NGxoNGY MAXX eMAXY 


310 FORMAT({H o# AT 310% GF 12040419) 

318 CONTINUE 
5 | NWPC = 6 
4 XuTSm 2 0, 
a eEmTSm 2 9, 
; Oo 24 { # 1yMAXx 
t Do 24 y = 1yMAxy 
KB 1 @ MAXX® (yell) 
q IPNT(K) = 0 
" 24 CONTINUE 
oY NNZ ® 0 
* 
b | : 
“i 30 CONTINUE (Fak Wipers 

00 39 I # Ie INw ae Uy 
a IF (TUACH(T) «NE. KNBFPB) GO TO 39 OS Bed te a 
a | IRUGA ® FHUGA « 1 ‘ aare A, Soter 
P = e a o x e Lal a h 
é S ; ees FLONW(I)) 0X © XLX)/DISTX © OLSTHX Pf wrnper ny 
| Ivy # (Fy aTW{T) © FLATCG)®OY © XLY)/OESTY * DYSTHY 
F ly sty ¢ | 
ITROB a 0 

: | TE (IX eLEe MAXX oANDe ITY olEs MAXY) G7 TO 41 AL afore wnoegh 
iH #eee UNCLASSIFIED e##e ~ ~~ 11/30/76 PAGE NO. On 


=a 


es a 


eT ee 
* 


a re tt 


iar 


een 


40 


41 


102 


101 


#e*® UNCLASSIFIED *##e0@ 11/30/76 PAGE NO. 00 

wRITE(MQ,40) KNBFPA,KNBFPBs IXelYeYLOGI) pICLwW(1) sIWAT (1) oFLATW(I) 9 

1 FLATW(T) oer ‘| 
FORMAT( 1H 9® Too LARGE AT ® sASe1XeA@e ® AT GRID X/Y @ 92145 Br / Ud pwlers 

1 @ wWPN YLO/CL NO,/TYPE = % F6,19 I591X9A2e @ AT LAT/LON @ @, of 
2 2F904) ; ‘ hii 4 

TE (IX eGTe MAXX) IX @ Maxx ong how 

IF (LY eGT pMAXY) IY = MAXY Peo 

ITROB = 0G 

CONTINUE 

IF (IX «GE. eANDe IY.GE.}) GO TO 10) 

WRITE (MQ_,102) KNGFPAsKNGFPB® IXSTYeYLDIT) sICLW(I) oIWAT(T) SFLATW(I) » 

1 FLATW(I) 

FORMAT( 1H »# TOO SMALL AT @ sASe1xXeA%, @ AT GRID X/Y = % 9214, 
j : oa YLD/CL NOe/TYPE = #9 F6o1* 15%)XeA29 @ AT LAT/LON @ 

F9e%) ~ 

Ip (1X eLT. 1) rx 21 

Ie (1Y eb Te 1) yy 2 1 

ITROg = 1 

CONTINUE 


C####e8UGGGGGGGG 


315 


IF (1dUGCT eGTel) GO. TO 44 
WRITE (MQ9345) KCNToMNBFPASMNBFPB® [Xe 1 Y¥eMAXXoMAXY 
FORMAT(1HO #=2= AT 315 NOW Ee AT#eI5_, 2X2A50A4,419) 


C##e##e#edUGGGGGGG 


312 
44 


342 
349 
343 


WRITE(MQ® 312) FLONCGeFLONI(T) sFLATI(Y) sFLATCGs XLXeALY 

FORMAT( 1H 9® AT 312 #9 6F1204) 

CONTINUE 

NWPC = NWPC * } 

XmTSM = xmMTSM @ YLO(T) py 4, AS 
EmT 2 YLO(T) #80,664¢666667 Pers gouvilud e 
EMTSM = EMTSM ¢ EMT (eo getestor 
J 2 IX *(TY © 1) Maxx ; 

IF (IPNT(.)) 0EG09) Go To 42 

IPNT(y) # IPNT(Q) © EMT 

Go To 43 

CONTINUE 

NNZ 32 NNZ @ } 

IPNT( J) = EMT 

CONTINUE 

IF(ITROB .EQ01) IPNT(J) # 99 

CONTINUE 


AT THI S POINT aRRAY S FILLED NOW START OUTPUT [ +, Fes pt 


a 
FIRST HEADERS FOR THE CITY / pacts 
CONTINUE 


5 
€**#**83UGGGGGGGG 


IF (IBUGCT eGTe 1) Go To 343 

DO 340 UY = LeMAXY 

Do 340 I = leMAxx 

Ks I ¢ (Jol) *MAxx 

WRITE (MQe342) T9geKe ITPNT(K) 

FORMAT(1H 9® ARRAAY PT #0931595x0110) 
CONTINUE 

CONTINUE 

IF ‘ISKIO.EQe1) GO To 20 

JOUTCT * youTcT « 1 

WRITE (MT946) MF RO,g MRTHeMRCT 9 JOUTCTyINGFPAsUNBFPBs TPOPT, 
1 FLATCG9FLONCGs NGYeNGXeALY oXLXeMAXY 9 MAX 


#e#@ UNCLASSIFIED ##0 11/30/76 PAGE NO. ont | 


2 ere 


ee ee ee 


46 


47 


431 


48 


442 


83 


$5 


54 


eeee UNCLASSIFIED see 11/30/76 PAGE NO, Ont 

FORMAT(A] sAGo1X9AbelISe 1 AsASeAGelXs lGe2F Boao Xo2laelxe2F Bede me 
1 149274) 

Ir (180 eNEs 1 ) GO TO 431 

JoUTY = youTy « 1 

WRITE(MU967) MFRBOoMRTYHeMRIYs JOUTYs JNBFPA®INBFPBe IPOPT » 

1 FLATCGPFLONCGs NGY pNGAeALY eXLXeMAXY g MAXX 

FORMAT(AY sA%alXeASeISslXeASsASelXs 19eCFBedelXelloelXe2cFT ode 

1 1X9214) 

CONTINUE 

JOUTMP 2 JOUTMP © } 

WRITE( MVe94g) MFBSeMRTMPHoMRTMP» JOUTMP» JNBFPAeJNBFPBs 

1 NAMEAP oNAMEBP» 
2 JNBFPB*INBFPAs IPOPTs FLATCGeFLONCGs NGY#NGXe XLYsXLXo 
3 MAXY g MAXX 
FORMAT( Aly AdglXeAGelSalXeASeASelXe///y 20Xe POPULATION GRID MAP 
FOR THE CITY OF #9Al109A8 o// # MAP FOR URBANIZED AREA 
NOe *9AGe® WITH STATE COUNTY COpE #9459 » AND POPULATION = #9199 
7¥* LATITUDE/LONGITUDE OF CeoGe OF POPULATION = "e FB.492X oF Bebe 

7+® GRID STEPS SOUTH /WEST OF CeoGe 2 %92l6s * AT DISTANCES OF *» 
ee o/9 * N/S GRID STEPS = *#¢ y69% AND EW GRIn STEPS =H 
1®) 
WRITE (MV 9442) NWRCy NNZoXMTSMeEMTSM 
FORMAT(1HOs *® FCR THIS CITY NUMBER OF WEAPONS 8 "e14e @ AT %oT4e 
1 ® GRID POINTS, TOTAL MEGATONS s#, F9,2,@ AND EQUIVALENT MEGATONS 
2? 2%9F9e2 o//) 

00 62 I 2 1eMAXX 

Ir = 1710 

Ia 3 I = yr#lo 

IF(IA eEQ. 0) GC TO 83 

LNPRT(1T) 2 lHe 

Go TO 82 

CONTINUE 

IF (II «GT. 10) GO To 8&4 

LNPRT(T) = YNUMRA(TT) 

Go To 82 

CONTINUE 

Ir = Il - 10 

Go To a3 

CONTINUE 

LNPRTI(NGX * 1) = 1H® 

MQITE(MV985) (LNPRT (1) 9r 3 lemaxx ) 

FoRMAT( by ,3x_ P3lql) 


aowF wre 


Now START aT TOP LINE aNO “ORK DOWN d 


NINCT 3 0 

NsScT 2 9 

Iy = MAXY « 1 

CONTINUE 

NeW LINE 

Ix 2 0 

CONTINUE 

Ix 2 Ix ¢ ]} 

IE (IX eleeMAXX) GO TO 52 
ITM a2 Maxy « 1 

IF (IY e€Q. ITM) GO TO 72 
JOUTMP = jOUTMP @ 1 

ITM & NGY © 1 

IF (IY eNew TTM) GO TO 406 


eeee UNCLASSIFIED eee 11/30/76 PAGE NO. 00 


@#*® UNCLASSIFIED #00 
WRITE (MV 4407) (LNPRT(I) oI mw LyMAXX  ) 
407 FORMAT(1H #2X91H** 13141) 
Go TO a7 
406 CONTINUE 
ITTM @ MAXY = IY 
JPR = [TTm 10 
IT 3 [TTmM = yPRel0 
IF (ITM e&Qe 9) GO To 86 
WRITE(M¥e98) (LNPRT(I) eI # 1 eMAXX ) 
88 FORMAT(1H 42XelHes 131aAl) 
Go TO a7 
86 CONTINUE 
WRITE (MVe73) JPRe(LNPRT(I)s I = 3 oMAXX) 
73 FORMAT(1H o13» 131A1) 
87 CONTINUE 
72 CONTINUE 
Iy 2 ly -] 
IF(IY oLT. 1) GO TO 53 
Go To SS 
52 CONTINUE 
J 3 (IY © 1) MAXX © IX 
IF (IEPNT()) oNEe%) Go To 74 
JTTM = MAXX © lg 
JTM = MAKY @ 19 
IF (IY oNee 20 eANDe IY eNEe UTM) GO TO 411 
Ie 41x .LT. 20 eORe YX eGTe JTTM ) Go fo 611 
LNPRT(IA) = lee 
Go To 412 
411 CONTINUE 
IF (IX eNE. 20 eANDe IXe NEe JTTM) GO FO 413 
IF(TY eLT. 29 .OR. TY oGTe UTM) GO TO 413 
LNPRT(IX) = ly, 
Go TO 472 
413 CONTINUE 
LNPRT(IX) = 1H 
412 CONTINUE 
Go TO 408 
74 CONTINUE 
K = IPNT(y) #2 
C###**81)GGGGGGRG 
IF(K oGE. 0) GO To 632 
WRITE (MQ 5633) Ko IxelY¥odgIPNT (J) 
633 FORMAT (1H 9* AT LOI WITH NEG K*» 5310) 
K 20 
632 CONTINUE 
K3K 62 
IF (K «LE. 38) GO TO 71 
K 2 40 
71 CANTINUE 
LNPRT(IX) = LNVAL(K) 
#98 = CONTINUE 


IFCIPNT(U) 2EQ.9) GO TO 54 
Ie (180 eNEe 1 ) GO TO 430 
Ife (NSSCT .NEe 0) GO TO 91 
neSc?t 2 l 
“OOPCI(NSSCT) = IPNT(Y) 
tvO 2 {Y 

feo wa 

‘ .* es 


wo TO 92 


@e*e UNCLASSIFIED *### 


11/30/76 


11/30/76 


PAGE NO. Ont 


b 


PAGE NO. 0006 


oe} 


91 


81 


93 


94 


95 


S1 


6l 


62 
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CONTINUE 7 
ITM # IXL 6 1 
IF (LTM eEQeIX) GO To 93 
JOUTY = youTY « 1 
WRITE (MUygl) MFaeMRTY sMRTYSJOUTY s JNBFRAPINBFPR® NSSCTs 
1 1XOeLYO, (KPOPO(T) opal eNSSCT) 
FORMAT (A) ,AG a1 XeAGelISelXoASgAGelXel2edl4e1417) 


IvO = IY 

IxO 2 IX 

IxXL = [% 

NSScT 2 1 

KPOPO(NSScT) # TPNT(U) 4 fa ; 
Go To 92 (TYfAa aKa? 
CONTINUE 4 we, fe 


IF(NSSCT .LTe NSSMX) GO TO 94 
JoUTY = youTY « 1 
WRITE(MUsg1) MF AeMRTYoMRTY sJOUTY 9UNGFRASUNBFPR® NSSCTs 
1 rXOerYOs (KPOPO(L) spl eNSSCT) 
Tyo 2 ITY 
1xO 3 Ix 
IXL 2 IA 
NSScT = 1 
KPOPO(NSSCT) 3 IPNT(J) 
Go TO 92 
CONTINUE 
IF (IYO eEQeIY) GO TO 95 
JOUTY 2 yoUTY «+ 1 
WRITE (MUsgl) MEQeMRTYoMRTYs JOUTY sUNBF& AS INBFPR® NSSCTs 
1 1XOvLyYO* (KPOPO(I) 972! »NSSCT) 
TyO = TY 
1x0 2 IX 
Ixl 2 [x 
NSScT 2 1 
KPOPO(NSScCT) # IPNT(YU) 
Go TO 9? 
CONTINUE 
NsScT = NSScT ¢ 1 
KPOPO(NSSCT) 2 YPNT(y) 


IXL 3 [x 
CONTINUE 

CONTINUE 

IF(NINCT .LTe6) GO TO 462 ot 
CONTINUE Culpel BPO 
JOUTCT = yOuTCT « 1 eee: yh iee 
WAITE(MT95)) MFQe MRCToMRCT 9 JOUTCT® JNBFPAsJNBFPBe 6 
L NINCTs (TARR(L) sJARR(I) sNPARR(I) 92106) 

FORMAT (Al AS 9 1X AS oe So1X aA AS oI XoT1 oIxvO (149 14e18e1X)) 

OC 61 Is 1,6 

TARR(T) = 9 

JaRR(T) 2 0 

NPARR(I) = 0 

CONTINUE 

NINCT = 1 

TaRR(NINCT) & IX 

JARRININGT) @ TY 

NPARR(NINCT) 2 IPNT(J) 

Go TO 54 

CONTINUE 

NINCT = NINCT ¢ } 

TaRR(NINCT) 2 IX rae 
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